home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 23 / AACD 23.iso / AACD / Utilities / FWCalendar / FWCAddEvent.rexx < prev    next >
OS/2 REXX Batch file  |  2001-06-09  |  98KB  |  2,716 lines
  1. /*
  2.     AddEvent.rexx Macro
  3.     Adds events to calendars created by FWCalendar.rexx
  4.     $VER: FWCAddEvent.rexx v3.95 (3 Jun 2001)
  5.     ©Ron Goertz (goertz@earthlink.net)
  6. */
  7. OPTIONS RESULTS
  8. signal on syntax
  9. options failat 11
  10. Numeric Digits 14
  11.  
  12. parse source . . . FullCallPath . CallHost
  13. CallHost = strip(CallHost)
  14. ScriptDir = PathPart(FullCallPath)
  15.  
  16. CurrentDir = Pragma('D')
  17. if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'
  18.  
  19. call AddLibraries
  20. if ErrorCount > 0 then call Cleanup
  21.  
  22. address value DetermineHost()
  23. call SetVariables
  24.  
  25. Month = substr(TempDate,5,2) - 0
  26. PrevMonth = Month - 1
  27. if PrevMonth = 0 then PrevMonth = 12
  28. NextMonth = Month + 1
  29. if NextMonth = 13 then NextMonth = 1
  30.  
  31. Year = left(TempDate,4)
  32. if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29
  33.  
  34. interpret "StartDate = Day."Date('W', TempDate, 'S')
  35. if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
  36. else MaxDate = 35 - StartDate
  37.  
  38. FontName = Font.Highlight
  39. FontSize = FSize.Highlight
  40. if ClassAct == 1 then call GetEvent_CA
  41. else call GetEvent_BGUI
  42. exit
  43.  
  44. /*********************************************/
  45. /*              Subroutines                  */
  46. /*********************************************/
  47. /***//*** AddBGUI (AB) ***/
  48. AddBGUI:
  49.   i = 0; AL_RexxBGUILib = i; AL_Lib.i = 'rexxbgui.library';    AL_MinVersion.i = 4;     AL_Offset.i = -30;  AL_Variable.i = 'RexxBGUILib'; AL_Status.i = "E"
  50.   i = 1; AL_BGUILib = i;     AL_Lib.i = 'bgui.library';        AL_MinVersion.i = 41.1;  AL_Offset.i = '' ;  AL_Variable.i = 'BGUILib';     AL_Status.i = "E"
  51.  
  52.   do i = 0 to 1
  53.     if exists('LIBS:'AL_lib.i) then do
  54.       AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
  55.       AL_LibCount = AL_LibCount + 1
  56.       Library.Name.AL_LibCount = AL_Lib.i
  57.       Library.Version.AL_LibCount = AL_InstalledVersion
  58.       if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
  59.         call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
  60.         interpret Al_Variable.i' = 0'
  61.       end
  62.       else do
  63.         if i ~= AL_BGUILib then call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
  64.         interpret Al_Variable.i' = 1'
  65.       end
  66.     end
  67.     else do
  68.       interpret Al_Variable.i' = 0'
  69.       if (i = AL_RexxBGUILib) | (i = AL_BGUILib) then do
  70.         if GUIWarning == 0 then do
  71.           GUIWarning = 1
  72.           call AddMsg('E', 'Either the ClassAct files or the BGUI files (see the docs)')
  73.           call AddMsg('E', '  must be installed. Neither could be found...')
  74.         end
  75.       end
  76.       else if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
  77.     end
  78.   end
  79.   if RexxBGUILib == 1 then ClassAct = 0
  80. say bguiopen
  81.   if (ClassAct == 0) & (bguiopen = 0) then bguiopen = bguiopen()
  82. say bguiopen
  83.  
  84.   return
  85. /**/
  86.  
  87. /***//*** AddLibraries (AL) ***/
  88. AddLibraries:
  89.   AL_LibCount     = 0
  90.   DoingCleanup    = 0
  91.   PortList        = show('P')
  92.   ErrorCount      = 0
  93.   HostScreen      = ''
  94.   WarningCount    = 0
  95.   Req             = 0
  96.   bguiopen        = 0
  97.   Storage         = 'RAM:FWC/'
  98.   ClassAct        = 0
  99.   ForceBGUI       = 0
  100.   ReqCAVersion    = 44.569
  101.   ReqAPVersion    = 2.48
  102.   ReqCAVersion    = 42.8
  103.   ClassActMessage = ''
  104.   AWNPipeMessage  = ''
  105.   GUIWarning      = 0
  106.  
  107.   call TranslationStrings
  108.   interpret ReadFile(ScriptDir'FWCTranslations.txt')
  109.  
  110.   i = 0; AL_DateLib = i;     AL_Lib.i = 'date.library';        AL_MinVersion.i = 33.31; AL_Offset.i = -492; AL_Variable.i = 'DateLib';     AL_Status.i = "W"
  111.   i = 1; AL_RexxMathLib = i; AL_Lib.i = 'rexxmathlib.library'; AL_MinVersion.i = 38.01;  AL_Offset.i = -30;  AL_Variable.i = 'RexxMathLib'; AL_Status.i = "W"
  112.  
  113.   if (exists('L:awnpipe-handler')) then do
  114.     if (exists('LIBS:gadgets/layout.gadget')) then do
  115.     ClassActVersion = PgmVer('LIBS:gadgets/layout.gadget')
  116.     AWNPipeVersion  = PgmVer('L:awnpipe-handler')
  117.     if ClassActVersion < ReqCAVersion then do
  118.       ClassActMessage = 'ClassAct version 'ReqCAVersion'+ is required; your version is 'ClassActVersion'. BGUI is being used'
  119.       ForceBGUI = 1
  120.     end
  121.     if AWNPipeVersion < ReqAPVersion then do
  122.       AWNPipeMessage = 'AWNPipe version 'ReqAPVersion'+ is required; your version is 'AWNPipeVersion'. BGUI is being used'
  123.       ForceBGUI = 1
  124.     end
  125.     if ForceBGUI == 0 then ClassAct = 1
  126.   end
  127.   if ForceBGUI == 1 then ClassAct = 0
  128.  
  129.   do i = 0 to 1
  130.     if exists('LIBS:'AL_lib.i) then do
  131.       AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
  132.       AL_LibCount = AL_LibCount + 1
  133.       Library.Name.AL_LibCount = AL_Lib.i
  134.       Library.Version.AL_LibCount = AL_InstalledVersion
  135. if (i == AL_RexxMathLib) & (AL_InstalledVersion == '38.02') then AL_InstalledVersion = 38.2
  136.       if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
  137.         call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
  138.         interpret Al_Variable.i' = 0'
  139.       end
  140.       else do
  141.         call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
  142.         interpret Al_Variable.i' = 1'
  143.       end
  144.     end
  145.     else do
  146.       interpret Al_Variable.i' = 0'
  147.       if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
  148.     end
  149.   end
  150.   if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
  151.   else PhaseLib = 0
  152.  
  153.   if ForceBGUI == 1 then call AddBGUI
  154.  
  155.   if ErrorCount > 0 then call Cleanup
  156.   return
  157. /**/
  158.  
  159. /***//*** AddMsg (AM) Subroutine ***/
  160. AddMsg:
  161.   parse arg AM_MsgType, AM_Msg
  162.  
  163.   if AM_MsgType == 'E' then do
  164.     ErrorCount = ErrorCount + 1
  165.     Error.ErrorCount = AM_Msg
  166.   end
  167.   else do
  168.     WarningCount = WarningCount + 1
  169.     Warning.WarningCount = AM_Msg
  170.   end
  171.  
  172.   return
  173. /**/
  174.  
  175. /***//*** AssignID (AID) ***/
  176. AssignID:
  177.   parse arg AID_Var, AID_ID
  178.  
  179.   interpret AID_Var' = 'AID_ID
  180.   GE_Gad.AID_ID = AID_Var
  181.   if left(AID_Var, 5) = 'GadID' then AID_Var = 'GadID'
  182.   GE_Help.AID_ID = AID_Var'Help'
  183.  
  184.   return
  185. /**/
  186.  
  187. /***//*** BusyReq (BR) ***/
  188. /*** OpenBusy ***/
  189. OpenBusy:
  190.   parse arg BR_BusyTitle, BR_EventCount
  191.   BR_Progress = 0
  192.   if ClassAct == 1 then do
  193.     call open('ProgReq', "awnpipe:ProgressReq/xc")
  194.     call ToPIPE('ProgReq', 'm v cs si so a ps="'AppScreen'"')
  195.     call ToPIPE('ProgReq', 'label gt="'BR_BusyTitle', 'PleaseWait$'..."')
  196.     BR_ProgressGad = ToPIPE('ProgReq', 'fuelgauge defn=0 maxn='BR_EventCount' t=0 per')
  197.     call ToPIPE('ProgReq', 'layout b=0 si so cj')
  198.       call ToPIPE('ProgReq', 'space')
  199.       BR_CancelGad = ToPIPE('ProgReq', 'button pb gt="'Cancel$'"')
  200.       call ToPIPE('ProgReq', 'space')
  201.     call ToPIPE('ProgReq', 'le')
  202.     if ToPIPE('ProgReq', 'open') == 'window' then BR_ProgressWindow = 1
  203.     else BR_ProgressWindow = 0
  204.   end
  205.   else do
  206.     BR_ProgressGroup=bguivgroup(,
  207.           bguiinfo('BR_dummy',,'1B'x||'c'BR_BusyTitle', 'PleaseWait$'...')bguilayout(LGO_FixMinHeight,1)||,
  208.           bguiprogress('BR_prog2_',,0,BR_EventCount)||,
  209.           bguihgroup(,
  210.                   bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
  211.                   bguibutton('BR_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
  212.                   bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
  213.           ,,,,'W'),
  214.     ,-2,-2)
  215.     BR_ProgressWindow = bguiwindow('',BR_ProgressGroup,,2,,AppScreen)
  216.     if bguiwinopen(BR_ProgressWindow) = 0 then call Cleanup
  217.   end
  218.  
  219.   return BR_ProgressWindow
  220.  
  221. /*** UpdateBusy ***/
  222. UpdateBusy:
  223.   parse arg BR_ReqWin, BR_ProgressMade
  224.  
  225.   if BR_ReqWin == 0 then return 0
  226.   BR_Progress = BR_Progress + BR_ProgressMade
  227. /* say '>'BR_Progress SIGL */
  228.   if ClassAct == 1 then do
  229.     if show('F', 'ProgReq') == 1 then do
  230.       call writeln('ProgReq', 'id 'BR_CancelGad' read')
  231.       BR_CancelStatus = readln('ProgReq')
  232.       if BR_CancelStatus == 1 then do
  233.         call close('ProgReq')
  234.         return -1
  235.       end
  236.     end
  237.     else return 0
  238.     if show('F', 'ProgReq') == 1 then do
  239.       call ToPIPE('ProgReq', 'id 0 s=2')
  240.       call writeln('ProgReq', 'id 'BR_ProgressGad' defn='BR_Progress' ref')
  241.       call readln('ProgReq')
  242.     end
  243.     else return 0
  244.   end
  245.   else do
  246.     call bguiset(obj.BR_prog2_,BR_ReqWin,PROGRESS_Done,BR_Progress)
  247.     if bguiwinevent(BR_ReqWin,'ID') == id.BR_cancel_ then return -1
  248.   end
  249.  
  250.   return BR_Progress
  251.  
  252. /*** CloseBusy ***/
  253. CloseBusy:
  254.   parse arg BR_ReqWin
  255.  
  256.   if BR_ReqWin == 0 then return 0
  257.  
  258.   if ClassAct == 1 then call close('ProgReq')
  259.   else call bguiwinclose(BR_ReqWin)
  260.   Req = 0
  261.  
  262.   return 0
  263. /**/
  264.  
  265. /***//*** CAGetFile (GF) ***/
  266. CAGetFile:
  267.   parse arg GF_FileHandle, GF_GadID, GF_Title, GF_InitDir
  268.  
  269.   call writeln(GF_FileHandle,'id 'GF_GadID' gt="'GF_Title':" fn="'GF_InitDir'" s=1')
  270.   GF_GetFileResult = readln(GF_FileHandle)
  271.   parse var GF_GetFileResult GF_OK GF_Choice GF_File
  272.   if GF_Choice ~= 0 then GF_File = strip(GF_File, 'B', '" ')
  273.   else GF_File = ''
  274.  
  275.   return GF_File
  276. /**/
  277.  
  278. /***//*** CASimpleReq (CAS) ***/
  279. CASimpleReq:
  280.   parse arg CAS_Title, CAS_Msg, CAS_Time
  281.  
  282.   if CAS_Time == '' then do
  283.     CAS_Msg = translate(CAS_Msg, "'", '"')
  284.     do while pos('0a'x, CAS_Msg) > 0
  285.       CAS_Msg = left(CAS_Msg, pos('0a'x, CAS_Msg) - 1)'*n'substr(CAS_Msg, pos('0a'x, CAS_Msg) + 1)
  286.     end
  287.  
  288.     call open('Req', "awnpipe:SimpleReq/xc")
  289.     call ToPIPE('Req', '"'CAS_Title'" v db dg si so a ps="'AppScreen'"')
  290.     call ToPIPE('Req', 'label gt="'CAS_Msg'"')
  291.     call ToPIPE('Req', 'layout b=0 si so cj')
  292.       call ToPIPE('Req', 'space')
  293.       call ToPIPE('Req', 'button c gt="'OK$'"')
  294.       call ToPIPE('Req', 'space')
  295.     call ToPIPE('Req', 'le')
  296.     call ToPIPE('Req', 'open')
  297.  
  298.     do while ~eof('Req')
  299.       call readln('Req')
  300.     end
  301.     call close('Req')
  302.   end
  303.   else do
  304.     call open('Req', "awnpipe:SimpleReq/xc")
  305.     call ToPIPE('Req', 'm sk si so a ps="'AppScreen'"')
  306.     call ToPIPE('Req', 'label gt="'CAS_Msg'"')
  307.     call ToPIPE('Req', 'open')
  308.  
  309.     CAS_TickCount = 0
  310.     do until CAS_TickCount >= CAS_Time
  311.       call ToPIPE('Req', 'tick 100')
  312.       Req_EventInfo = readln('Req')
  313.       parse var Req_EventInfo Req_Event' 'Req_GadID' 'Req_GadInfo1
  314.       select
  315.         when Req_Event == 'key' then CAS_TickCount = CAS_Time
  316.         when Req_Event = 'tick' then CAS_TickCount = CAS_TickCount + 1
  317.         otherwise nop
  318.       end
  319.     end
  320.     call close('Req')
  321.   end
  322.  
  323.   return
  324. /**/
  325.  
  326. /***//*** Cleanup () Subroutine ***/
  327. Cleanup:
  328.   signal off syntax
  329.  
  330.   if VariablesSet == 1 then do
  331.     interpret UserPrefs
  332.     call CloseBusy(Req)
  333.     if App == 'FW' then do
  334.       SELECTOBJECT
  335.       REDRAW
  336.       if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
  337.     end
  338.     else if App == 'PGS' then do
  339.       SELECTOBJECT None WINDOW winName
  340.       if WindowRefreshed ~= 1 then do
  341.         REFRESH ON
  342.         REFRESHWINDOW WINDOW winName
  343.       end
  344.     end
  345.   end
  346.  
  347.   LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  348.   if LogOpen == 0 then do
  349.     address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
  350.     LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  351.   end
  352.   if LogOpen == 1 then OutType = 'File'
  353.   if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
  354.     LogOpen = 1
  355.     call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
  356.     OutType = 'CON'
  357.   end
  358.  
  359.   if LogOpen == 1 then do
  360.     call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
  361.     call writeln('FWCLog', 'Application: 'PgmVersion)
  362.     call writeln('FWCLog', 'Current Dir: 'CurrentDir)
  363.     call writeln('FWCLog', ' Script Dir: 'ScriptDir)
  364.     call writeln('FWCLog', '       Host: 'CallHost)
  365.     call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  366.   end
  367.  
  368.   if (ErrorCount > 0) | (WarningCount > 0) then do
  369.     do i = 1 to ErrorCount
  370.       call writeln('FWCLog', Error.i)
  371.     end
  372.  
  373.     do i = 1 to WarningCount
  374.       call writeln('FWCLog', Warning.i)
  375.     end
  376.  
  377.     if (PrefsFile ~= '') & (exists(PrefsFile)) then do
  378.       call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
  379.       call open('DataFile', PrefsFile)
  380.         do until eof('DataFile')
  381.           Ln = ReadLn('DataFile')
  382.           if pos('End Pass One', Ln) > 0 then leave
  383.           call writeln('FWCLog', Ln)
  384.         end
  385.       call close('DataFile')
  386.     end
  387.  
  388.     if (EventFile ~= '') & (symbol('EventFile') == 'VAR') then do
  389.       call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
  390.       call open('DataFile', EventFile)
  391.         do while ~eof('DataFile')
  392.           if ~eof('DataFile') then call writeln('FWCLog', ReadLn('DataFile'))
  393.         end
  394.       call close('DataFile')
  395.     end
  396.  
  397.     if ErrorCount > 0 then ErrorType = Critical$
  398.     else ErrorType = Noncritical$
  399.     FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  400.     Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  401.     ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <goertz@earthlink.net>'||'0a'x||Unable$
  402.  
  403.     if (OutType == 'File') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, FileMsg)
  404.     if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  405.     if (OutType == 'File') & (bguiopen == 0) & (ClassAct == 0) then do
  406.       call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
  407.         call writeln('CON', FileMsg)
  408.       call close('CON')
  409.     end
  410.  
  411.     if (OutType == 'CON') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, Conbgui)
  412.     if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
  413.     if (OutType == 'CON') & (bguiopen == 0) & (ClassAct == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  414.   end
  415.   else do
  416.     address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
  417.     if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  418.   end
  419.  
  420.   address command 'delete >NIL: 'Storage'FWCTemp quiet'
  421.   call close('FWCLog')
  422.   if bguiopen = 1 then call bguiclose()
  423.   exit
  424. /**/
  425.  
  426. /***//*** ConvertDay (CD) Subroutine***/
  427. ConvertDay:
  428.   parse arg CD_Day
  429.   If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  430.   If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  431.   return CD_Day
  432. /**/
  433.  
  434. /***//*** DetermineHost () Subroutine ***/
  435. DetermineHost:
  436.   owner = ReadFile('ENV:Owner')
  437.   if (pos('FINALWRITER', upper(CurrentDir)) > 0) | (left(CallHost, 6) == 'FINALW') then do
  438.     App     = 'FW'
  439.     AppName = 'FINALWRITER'
  440.     if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
  441.     else HostPort = CallHost
  442.     address value HostPort
  443.     GETDOCITEMPREFS Decimal; DecimalFormat = result
  444.     DOCITEMPREFS Decimal Period
  445.   end
  446.   else if (pos('PAGESTREAM', upper(CurrentDir)) > 0) | (CallHost == 'PAGESTREAM') then do
  447.     App     = 'PGS'
  448.     AppName = 'PAGESTREAM'
  449.     HostPort = 'PAGESTREAM'
  450.   end
  451.   else do
  452.     call AddMsg('E', 'Unable to determine host!')
  453.     call AddMsg('E', 'Make sure FWCAddEvent is called from Final Writer or PageStream')
  454.     call Cleanup
  455.   end
  456.  
  457.   PgmVersion = getclip('FWC'App'VersionInfo.txt')
  458.   if PgmVersion == '' then do
  459.     address command 'list >PIPE:FWC 'AppName'#? lformat %N'
  460.     ListOutput = ReadFile('PIPE:FWC')
  461.     call openv('ListOutput')
  462.       do while ~eofv('ListOutput')
  463.         PgmName = readvln('ListOutput')
  464.         if pos('.', PgmName) == 0 then leave
  465.       end
  466.     call closev('ListOutput')
  467.     address command 'version >PIPE:FWC 'PgmName
  468.     PgmVersion = ReadFile('PIPE:FWC')
  469.  
  470.     if left(PgmVersion, 34) == 'Could not find version information' then do
  471.       if App == 'FW' then do
  472.         call open('Temp', CurrentDir''PgmName)
  473.           /* Desired string at 325365 for v 5.06 */
  474.           /* Desired string at 333771 for FW97   */
  475.           FileOffset = 325300
  476.           call seek('Temp', FileOffset, 'B')
  477.           do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  478.             PrevOffset = FileOffset
  479.             Chunk = readch('Temp', 10000)
  480.             EndPos = pos('Created', Chunk)
  481.             if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  482.           end
  483.           if EndPos ~= 0 then do
  484.             StartPos = lastpos('Final', Chunk, EndPos)
  485.             EndPos = pos('00'x||'00'x, Chunk, StartPos)
  486.             PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
  487.           end
  488.           else do
  489.             FileOffset = 0
  490.             call seek('Temp', FileOffset, 'B')
  491.             do until (EndPos ~= 0) | (PrevOffset = FileOffset)
  492.               PrevOffset = FileOffset
  493.               Chunk = readch('Temp', 10000)
  494.               EndPos = pos('FinalWriter 97', Chunk)
  495.               if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
  496.             end
  497.             if EndPos ~= 0 then PgmVersion = 'FinalWriter 97'
  498.             else PgmVersion = 'Final Writer - version unknown'
  499.           end
  500.         call close('Temp')
  501.       end
  502.       else if App == 'PGS' then do
  503.         PgmVersion = PgmName" - can't find version info"
  504.       end
  505.       call setclip('FWC'App'VersionInfo.txt', PgmVersion)
  506.     end
  507.   end
  508.  
  509.   AppScreen = ''
  510.   PubScreenApps = 'FrontPubScreen Publican MagicPubName'
  511.   do i = 1 to words(PubScreenApps)
  512.     interpret 'address command "'word(PubScreenApps, i)' >PIPE:FWC"'
  513.     if RC > 0 then iterate
  514.     AppScreen = readfile('PIPE:FWC')
  515.     if AppScreen ~= '' then leave
  516.   end
  517.  
  518.   return HostPort
  519. /**/
  520.  
  521. /***//*** DrawBox (DB) Subroutine ***/
  522. DrawBox:
  523.   parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint
  524.  
  525.   if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0
  526.  
  527.   if App == 'FW' then do
  528.     if DB_Weight == 'HL' then DB_Weight = 'Hairline'
  529.     else if DB_Weight == 0 then do
  530.       DB_Weight = 'None'
  531.       if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
  532.     end
  533.  
  534.     if DB_FillBool == 1 then DB_FillBool = 'Solid'
  535.     else do
  536.       DB_FillBool = 'Transparent'
  537.       DB_FillColor = DB_Color
  538.     end
  539.  
  540.     BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
  541.     DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  542.   end
  543.   else if App == 'PGS' then do
  544.     if DB_Weight == 'HL' then DB_Weight = 0.3pt
  545.     else DB_Weight = DB_Weight'pt'
  546.  
  547.     if DB_FillBool == 1 then DB_FillBool = 'ON'
  548.     else DB_FillBool = 'OFF'
  549.  
  550.     If DB_Weight == 0 then DB_LineBool = 'OFF'
  551.     else DB_LineBool = 'ON'
  552.  
  553.     DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
  554.     STROKED DB_LineBool OBJECTID DB_id WINDOW winName
  555.     SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  556.     SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
  557.     FILLED DB_FillBool OBJECTID DB_id WINDOW winName
  558.     SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
  559.     SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  560.   end
  561.   return DB_id
  562. /**/
  563.  
  564. /***//*** dTox (PROCEDURE) Subroutine ***/
  565. dTox:PROCEDURE
  566. parse arg DecVal
  567.  
  568. BinVal = ''
  569. HexVal = ''
  570. do i = 32 to 0 by -1
  571.   if DecVal >= 2**i then do
  572.     BinVal = BinVal'1'
  573.     DecVal = DecVal - 2**i
  574.   end
  575.   else BinVal = BinVal'0'
  576. end
  577.  
  578. do until BinVal == ''
  579.   HexVal = c2x(b2c(right(BinVal, 8, '0')))''HexVal
  580.   if length(BinVal) >= 8 then CutLength = 8
  581.   else CutLength = length(BinVal)
  582.   BinVal = left(BinVal, length(BinVal) - CutLength)
  583. end
  584.  
  585. return HexVal
  586. /**/
  587.  
  588. /***//*** GetEvent_BGUI (GE) Subroutine ***/
  589. GetEvent_BGUI:
  590.   do GE_i = 0 to 15
  591.     linelist_.GE_i = GE_i
  592.   end
  593.   linelist_.COUNT = min(RowsThatFit, 16)
  594.  
  595.   call bguilist("eventlist_",Event$,File$)
  596.   call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)
  597.  
  598.   GE_StartOrEnd   = 1
  599.   GE_StartDate    = ""
  600.   GE_EndDate      = ""
  601.   GE_Boxed.0      = ""
  602.   GE_Boxed.128    = "B"
  603.   GE_Weekly.0     = ""
  604.   GE_Weekly.1     = "W"
  605.   GE_Weekly.2     = "2"
  606.   GadID.          = ''
  607.   GE_Arg.         = ''
  608.   GE_i            = 0
  609.   GE_Day          = 0
  610.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  611.   GE_NextDay      = 0
  612.  
  613.   Req = OpenBusy(PrepReq$, 45)
  614.   do while (GE_i < 6)
  615.     GE_j = 0
  616.     do while (GE_j < 7)
  617.       call UpdateBusy(Req, 1)
  618.       GE_SerialPosition = (GE_i * 7) + GE_j
  619.       GE_Button = GE_SerialPosition + 1
  620.       if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
  621.         GE_Day = GE_Day + 1
  622.         interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
  623.         GadID = GetID(GE_Button'_')
  624.         GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
  625.       end
  626.       else do
  627.         if GE_SerialPosition < StartDate then Do
  628.           GE_PrevDay = GE_PrevDay + 1
  629.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
  630.           GadID = GetID(GE_Button'_')
  631.           GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
  632.         end
  633.         else do
  634.           GE_NextDay = GE_NextDay + 1
  635.           interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
  636.           GadID = GetID(GE_Button'_')
  637.           GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
  638.         end
  639.       end
  640.       GE_j = GE_j + 1
  641.     end
  642.     GE_i = GE_i + 1
  643.     if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  644.   end
  645.  
  646.   DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
  647.                 bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
  648.                 bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
  649.                 bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  650.   if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  651.   if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)
  652.  
  653.   g=bguivgroup(,
  654.     bguihgroup(,
  655.       bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  656.       bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1),
  657.     )||,
  658.     bguihgroup(,
  659.       bguistring('fontvalue_',Font$':',FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
  660.       bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
  661.       bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  662.       bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
  663.     )||,
  664.     bguihgroup(,
  665.       bguivgroup(,
  666.         bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
  667.         bguihgroup(,
  668.           bguiinfo("dummy_",,esc"c"left(Day.0,1))||,
  669.           bguiinfo("dummy_",,esc"c"left(Day.1,1))||,
  670.           bguiinfo("dummy_",,esc"c"left(Day.2,1))||,
  671.           bguiinfo("dummy_",,esc"c"left(Day.3,1))||,
  672.           bguiinfo("dummy_",,esc"c"left(Day.4,1))||,
  673.           bguiinfo("dummy_",,esc"c"left(Day.5,1))||,
  674.           bguiinfo("dummy_",,esc"c"left(Day.6,1)),
  675.         )||,
  676.         DateButtons,
  677.       )||,
  678.       bguivgroup(,
  679.         bguiinfo("startchoice_",esc"r"Start$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  680.         bguiinfo("endchoice_",esc"r"End$':',"")bguilayout(LGO_FixMinHeight, 1)||,
  681.         bguicycle('textcolor_',esc"r"TextColor$':','TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  682.         bguicycle("linechoice_",esc"r"Line$':',"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  683.         bguicheckbox("boxchoice_",esc"r"Boxed$':',0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  684.         bguicycle('boxcolor_',esc"r"BoxColor$':','ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
  685.         bguicycle("weeklychoice_",esc"r"Frequency$':','FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
  686.         bguihgroup(,
  687.           bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
  688.           bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1),
  689.         ),
  690.       ),
  691.     ),
  692.   ,"-1","-1")
  693.  
  694.   call UpdateBusy(Req, 1)
  695.   GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,AppScreen)
  696.   call UpdateBusy(Req, 1)
  697.  
  698.   if App == 'PGS' then do
  699.     FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
  700.     call UpdateBusy(Req, 1)
  701.     FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,AppScreen)
  702.   end
  703.  
  704.   call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  705.   call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  706.   call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  707.   call bguiset(obj.event_,,BT_Key,EventKey)
  708.   call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  709.  
  710.   if bguiwinopen(GE_winID)=0 then bguierror(12)
  711.  
  712.   call CloseBusy(Req)
  713.  
  714.   id=0
  715.   do while 1
  716.     call bguiwinwaitevent(GE_winID,"ID")
  717.     select
  718.       when (id == id.cancel_) | (id == id.winclose) then call Cleanup
  719.       when id == id.winactive then nop
  720.       when id == id.wininactive then nop
  721.       when id == id.event_ then nop
  722.       when id == id.linechoice_ then nop
  723.       when id == id.boxchoice_ then nop
  724.       when id == id.textcolor_ then nop
  725.       when id == id.boxcolor_ then nop
  726.       when id == id.weeklychoice_ then nop
  727.       when id == id.reset_ then do
  728.         FontName = Font.Highlight
  729.         FontSize = FSize.Highlight
  730.         call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
  731.         call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
  732.       end
  733.       when id == id.fontvalue_ then do
  734.         call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
  735.         call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
  736.       end
  737.       when id == id.fontsize_ then nop
  738.       when id == id.addfont_ then do
  739.         call bguiwinbusy(GE_winID)
  740.         if App == 'FW' then do
  741.           FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', GE_winID,,'#?')
  742.           if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
  743.         end
  744.         else if App == 'PGS' then do
  745.           call bguiwinopen(FontwinID)
  746.           do while 1
  747.             call bguiwinwaitevent(FontwinID,'ID')
  748.             if id == id.winclose then leave
  749.             if id == id.fontlistview_ then do
  750.               call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
  751.               leave
  752.             end
  753.           end
  754.           call bguiwinclose(FontwinID)
  755.         end
  756.         call bguiwinready(GE_winID)
  757.         FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
  758.       end
  759.       when id == id.ok_ then do
  760.         GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
  761.         GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
  762.         GE_EventType  = bguiget(obj.eventtype_, CYC_Active)
  763.         if (GE_StartDate == "") & (Type.GE_EventType == Event$) then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  764.         else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  765.         else do
  766.           GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)
  767.  
  768.           EventData = "   EventType = "Type.GE_EventType||'0a'x||,
  769.                       " EnteredFont = "strip(FontName)||'0a'x||,
  770.                       " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
  771.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  772.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  773.                       " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
  774.                       "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
  775.                       "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
  776.                       "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
  777.                       "EnteredEvent = "GE_EventValue
  778.  
  779.           call bguiwinclose(GE_winID)
  780.           call ProcessEvent
  781.           call bguiwinopen(GE_winID)
  782.  
  783.           GE_StartOrEnd = 1
  784.           GE_StartDate  = ""
  785.           GE_EndDate    = ""
  786.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
  787.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
  788.         end
  789.       end
  790.       when id == id.eventtype_ then do
  791.         GE_EventType = bguiget(obj.eventtype_, CYC_Active)
  792.         if Type.GE_EventType == Event$ then do
  793.           call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
  794.           call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  795.           call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  796.           call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  797.           call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  798.           call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  799.           call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  800.           call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  801.           call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  802.           call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  803.         end
  804.         else do
  805.           GE_DataFile = bguifilereq(ScriptDir''"FWCAddEvent.data", SelectFile$, GE_winID,DOPATTERNS,PatVar)
  806.           if ~exists(GE_DataFile) then do
  807.             call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
  808.             GE_DataFile = ''
  809.           end
  810.           if GE_DataFile == '' then do
  811.             call bguiset(obj.eventtype_, GE_winID, CYC_Active, 0)
  812.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 0)
  813.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 0)
  814.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 0)
  815.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 0)
  816.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 0)
  817.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 0)
  818.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 0)
  819.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 0)
  820.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 0)
  821.           end
  822.           else do
  823.             call bguiset(obj.event_, GE_winID, STRINGA_TextVal,GE_DataFile)
  824.             call bguiset(obj.textcolor_, GE_winID, GA_Disabled, 1)
  825.             call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, 1)
  826.             call bguiset(obj.linechoice_, GE_winID, GA_Disabled, 1)
  827.             call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, 1)
  828.             call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, 1)
  829.             call bguiset(obj.reset_, GE_winID, GA_Disabled, 1)
  830.             call bguiset(obj.addfont_, GE_winID, GA_Disabled, 1)
  831.             call bguiset(obj.fontsize_, GE_winID, GA_Disabled, 1)
  832.             call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, 1)
  833.           end
  834.         end
  835.       end
  836.       otherwise do
  837.         GE_StartOrEnd = 1 - GE_StartOrEnd
  838.         GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
  839.         GE_Date = substr(GE_Arg.id, 3)
  840.         if GE_StartOrEnd == 0 then do
  841.           call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  842.           GE_StartDate = GE_ReturnDate
  843.         end
  844.         else do
  845.           call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
  846.           GE_EndDate = GE_ReturnDate
  847.         end
  848.       end
  849.     end
  850.   end
  851.   exit
  852. /**/
  853.  
  854. /***//*** GetEvent_CA (GE) Subroutine ***/
  855. GetEvent_CA:
  856.   /***//*** Initialize Variables ***/
  857.   Req = OpenBusy(PrepReq$, 4 + (ColorList.Count - 1))
  858.  
  859.   GE_BoxValue     = ''
  860.   GE_EnteredLine  = 1
  861.   GE_EventType    = Event$
  862.   GE_EventValue   = ''
  863.   GE_StartOrEnd   = 1
  864.   GE_StartDate    = ""
  865.   GE_EndDate      = ""
  866.   GE_WeeklyValue  = ''
  867.   GE_Day          = 0
  868.   GE_PrevDay      = MonthLength.PrevMonth - StartDate
  869.   GE_NextDay      = 0
  870.   LineList        = ''
  871.   ColorList       = ''
  872.   FontReq         = 0
  873.   ColorReq        = 0
  874.   NCColorReq      = 0
  875.   interpret 'GE_TextColor = ColorList.'max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0))
  876.   interpret 'GE_BoxColor = ColorList.'max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0))
  877.  
  878.   GadID.          = ''
  879.   GadArg.         = ''
  880.   GE_Boxed.0      = ""
  881.   GE_Boxed.1      = "B"
  882.   GE_Type.0       = Event$
  883.   GE_Type.1       = File$
  884.   GE_Weekly.0     = ""
  885.   GE_Weekly.1     = "W"
  886.   GE_Weekly.2     = "2"
  887.  
  888.   do GE_i = 0 to 15
  889.     LineList = LineList''GE_i'|'
  890.   end
  891.   LineList.Count = min(RowsThatFit, 16)
  892.  
  893.   do GE_i = 0 to ColorList.Count - 1
  894.     ColorList = ColorList''ColorList.GE_i'|'
  895.   end
  896.   ColorList = '"'strip(ColorList, 'B', '|')'"'
  897.  
  898.   EventList = '"'Event$'|'File$'"'
  899.   FrequencyList = '"'Once$'|'Weekly$'|'Biweekly$'"'
  900.  
  901.   if UpdateBusy(Req, 1) == -1 then call Cleanup
  902. /**/
  903.  
  904.   /***//*** GUI Description ***/
  905.   call open('GE',"awnpipe:AddEvent/xc")
  906.   FWCAddEventVersion = '('strip(word(sourceline(4), 3))')'
  907.  
  908.   call ToPIPE('GE', '"'EnterEventInfo$' 'FWCAddEventVersion'" m cg dg v db a so si cs sk h ps="'AppScreen'"')
  909.  
  910.   call ToPIPE('GE', 'layout v so si b=0')
  911.     call ToPIPE('GE', 'layout b=0')
  912.       call AssignID('GE_EventTypeGad', ToPIPE('GE', 'chooser weiw=0 pu cl='EventList' ref'))
  913.       call AssignID('GE_EventGad', ToPIPE('GE', 'string tc lj ref'))
  914.     call ToPIPE('GE', 'le')
  915.  
  916.     call ToPIPE('GE', 'layout b=0')
  917.       call ToPIPE('GE', 'label gt="'Font$':" ua ref')
  918.       call AssignID('GE_FontNameGad', ToPIPE('GE', 'string lj tc chl weiw=95 gt="'FontName'" ref'))
  919.       call AssignID('GE_FontSizeGad', ToPIPE('GE', 'string lj tc minc=4 weiw=0 gt="'FontSize'" ref'))
  920.       call AssignID('GE_ChooseFontGad', ToPIPE('GE', 'button ab=2 weiw=0 weih=0 ref'))
  921.       call AssignID('GE_ResetGad', ToPIPE('GE', 'button weih=0 weiw=0 gt="'Reset$'" ref'))
  922.     call ToPIPE('GE', 'le')
  923.   call ToPIPE('GE', 'le')
  924.  
  925.   call ToPIPE('GE', 'layout weiw=0 b=0')
  926.     call ToPIPE('GE', 'layout weiw=0 so v')
  927.       call ToPIPE('GE', 'layout so b=0')
  928.         call ToPIPE('GE', 'space')
  929.         call AssignID('GE_MonthGad', ToPIPE('GE', 'button ro b=0 gt="'Month.Month'" ref'))
  930.         call ToPIPE('GE', 'space')
  931.       call ToPIPE('GE', 'le')
  932.  
  933.       call ToPIPE('GE', 'layout e b=0')
  934.         do i = 0 to WeekDayCount
  935.           interpret "call ToPIPE('GE', 'button ro b=0 gt='QuoteMark''left(Day.i, 1)''QuoteMark' ref')"
  936.         end
  937.       call ToPIPE('GE', 'le')
  938.  
  939.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  940.  
  941.       do GE_Week = 0 to 5
  942.         if GE_Week * 7 + WeekdayCount < StartDate then do
  943.           GE_Day = 7 - StartDate
  944.           iterate
  945.         end
  946.         call ToPIPE('GE', 'layout e b=0')
  947.         do GE_WeekDay = 0 to 6
  948.           GE_Posn = (GE_Week * 7) + GE_WeekDay
  949.           if (GE_Posn >= StartDate) & (GE_Posn < StartDate + MonthLength.Month) then do
  950.             GE_Day = GE_Day + 1
  951.             if GE_WeekDay <= WeekdayCount then do
  952.               call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_Day'" ref'))
  953.               interpret "GadArg."GadID.GE_Posn" = 'C'left(Month.Month, 3)' 'GE_Day"
  954.             end
  955.           end
  956.           else do
  957.             if GE_Posn < StartDate then do
  958.               GE_PrevDay = GE_PrevDay + 1
  959.               if GE_WeekDay <= WeekdayCount then do
  960.                 call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_PrevDay'" ref'))
  961.                 interpret "GadArg."GadID.GE_Posn" = 'P'left(Month.PrevMonth, 3)' 'GE_PrevDay"
  962.               end
  963.             end
  964.             else do
  965.               GE_NextDay = GE_NextDay + 1
  966.               if GE_WeekDay <= WeekdayCount then do
  967.                 call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_NextDay'" ref'))
  968.                 interpret "GadArg."GadID.GE_Posn" = 'N'left(Month.NextMonth, 3)' 'GE_NextDay"
  969.               end
  970.             end
  971.           end
  972.         end
  973.         call ToPIPE('GE', 'le')
  974.         if GE_Posn >= StartDate + MonthLength.Month - 1 then leave
  975.       end
  976.     call ToPIPE('GE', 'le')
  977.  
  978.     if UpdateBusy(Req, 1) == -1 then call Cleanup
  979.     call ToPIPE('GE', 'layout weiw=0 si so v')
  980.       call ToPIPE('GE', 'layout weiw=0 si so b=0 v')
  981.         call ToPIPE('GE', 'label weiw=0 ua gt="'Start$':" ref')
  982.         call AssignID('GE_StartGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
  983.         call ToPIPE('GE', 'label weiw=0 ua gt="'End$':" ref')
  984.         call AssignID('GE_EndGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
  985.         call ToPIPE('GE', 'label weiw=0 gt="'TextColor$':" ua ref')
  986.         call AssignID('GE_TextColorGad', ToPIPE('GE', 'Button chl gt="'Color.AddEvent'" ref'))
  987.         call ToPIPE('GE', 'label weiw=0 gt="'Line$':" ua ref')
  988.         call AssignID('GE_LineGad', ToPIPE('GE', 'chooser chl pu weiw=0 s=1 maxn='LineList.Count' cl='LineList' ref'))
  989.         call ToPIPE('GE', 'label weiw=0 gt="'Boxed$':" ua ref')
  990.         call AssignID('GE_BoxedGad', ToPIPE('GE', 'checkbox weiw=0 chl ref'))
  991.         call ToPIPE('GE', 'label weiw=0 gt="'BoxColor$':" ua ref')
  992.         call AssignID('GE_BoxColorGad', ToPIPE('GE', 'Button chl gt="'Background.AddEvent'" ref'))
  993.         call ToPIPE('GE', 'label weiw=0 gt="'Frequency$':" ua ref')
  994.         call AssignID('GE_FrequencyGad', ToPIPE('GE', 'chooser chl pu weiw=0 maxn=3 cl='FrequencyList' ref'))
  995.       call ToPIPE('GE', 'le')
  996.       call ToPIPE('GE', 'layout v si e cj b=0')
  997.         call ToPIPE('GE', 'layout si e weiw=0 b=0')
  998.           call AssignID('GE_OKGad', ToPIPE('GE', 'button weiw=0 weih=0 gt="'OK$'" ref'))
  999.           call AssignID('GE_CancelGad', ToPIPE('GE', 'button weiw=0 weih=0 c gt="'Cancel$'" ref'))
  1000.         call ToPIPE('GE', 'le')
  1001.       call ToPIPE('GE', 'le')
  1002.     call ToPIPE('GE', 'le')
  1003.   call ToPIPE('GE', 'le')
  1004.  
  1005.   GetFileAllGad = ToPIPE('GE', 'getfile ua pat="#?"')
  1006.   GetFileDataGad = ToPIPE('GE', 'getfile ua pat="'PatVar'"')
  1007.  
  1008.   if App == 'PGS' then do
  1009.     call open('FontReq', "awnpipe:FontReq/xc")
  1010.     call ToPIPE('FontReq', '"'SelectFont$'" m db dg v a ps="'AppScreen'"')
  1011.     call ToPIPE('FontReq', 'listbrowser minw=200 minh=300')
  1012.     do GE_FontNumber = 0 to FontList.COUNT - 1
  1013.       GadID = ToPIPE('FontReq', 'browsernode gt="'FontList.GE_FontNumber'" ref')
  1014.       interpret 'FontGad.'GadID' = 'GE_FontNumber
  1015.     end
  1016.   end
  1017.  
  1018.   call open('ColorReq','awnpipe:ColorReq/xc')
  1019.   call ToPIPE('ColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  1020.   call ToPIPE('ColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')
  1021.  
  1022.   call open('NCColorReq','awnpipe:NCColorReq/xc')
  1023.   call ToPIPE('NCColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  1024.   call ToPIPE('NCColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')
  1025.  
  1026.   if App == 'FW' then do
  1027.     do GE_ColorNumber = 0 to ColorList.Count - 2
  1028.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  1029.       RPen = dTox(x2d(left(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
  1030.       GPen = dTox(x2d(substr(ColorRegister.GE_ColorNumber, 3, 2)) / 255 * 4294967295)
  1031.       BPen = dTox(x2d(right(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
  1032.  
  1033.       call ToPIPE('ColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
  1034.       GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
  1035.       interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1036.  
  1037.       call ToPIPE('NCColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
  1038.       GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
  1039.       interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
  1040.     end
  1041.     GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|¶" ref')
  1042.     interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1043.   end
  1044.   else if App == 'PGS' then do
  1045.     do GE_ColorNumber = 0 to ColorList.Count - 2
  1046.       if UpdateBusy(Req, 1) == -1 then call Cleanup
  1047.       GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
  1048.       interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1049.       GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
  1050.       interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
  1051.     end
  1052.     GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|" ref')
  1053.     interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  1054.   end
  1055.  
  1056. /**/
  1057.  
  1058.   /***//*** GUI Action Loop ***/
  1059.   call ToPIPE('GE', 'open')
  1060.   call UpdateBusy(Req, 1)
  1061.  
  1062.   call CloseBusy('ProgReq')
  1063.  
  1064.   do until eof('GE')
  1065.     call ToPIPE('GE', 'continue')
  1066.     GE_EventInfo = readln('GE')
  1067.     parse var GE_EventInfo GE_Event' 'GE_GadID' 'GE_GadInfo1
  1068.     select
  1069.     /***//*** close ***/
  1070.       when GE_Event == 'close' then call Cleanup
  1071.     /**/
  1072.  
  1073.     /***//*** Help event ***/
  1074.       when GE_Event == 'help' then do
  1075.         if GE_GadID ~= -1 then OverGad = GE_GadID
  1076.       end
  1077.     /**/
  1078.  
  1079.     /***//*** Key event ***/
  1080.       when GE_Event == 'key' then do
  1081.         HelpGad = GE_Help.OverGad
  1082.         interpret 'HelpText = Help$.'HelpGad
  1083.         if (GE_GadID == 95) & (symbol('Help$.'HelpGad) == 'VAR') then
  1084.           call CASimpleReq(Help$, HelpText, HelpTime)
  1085.       end
  1086.     /**/
  1087.  
  1088.     /***//*** GE_EventTypeGad ***/
  1089.       when GE_GadID == GE_EventTypeGad then do
  1090.         GE_EventType = GE_Type.GE_GadInfo1
  1091.         if GE_EventType == Event$ then do
  1092.           GE_StartOrEnd = 1
  1093.           call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
  1094.           call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
  1095.           call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
  1096.           call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
  1097.           call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
  1098.           call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
  1099.           call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
  1100.           call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
  1101.           call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
  1102.           call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
  1103.         end
  1104.         else do
  1105.           GE_DataFile = CAGetFile('GE', GetFileDataGad, SelectFile$, ScriptDir'FWCAddEvent.data')
  1106.           if GE_DataFile ~= '' then do
  1107.             if ~exists(GE_DataFile) then do
  1108.               call ToPIPE('GE', 'id 0 s=256')
  1109.               call CASimpleReq('FWCAddEvent 'Notice$, GE_DataFile' 'CantFind$'...')
  1110.               call ToPIPE('GE', 'id 0 s=512')
  1111.               GE_DataFile = ''
  1112.             end
  1113.             else do
  1114.               GE_EndDate = ''
  1115.               GE_EventValue = GE_DataFile
  1116.               call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
  1117.               call ToPIPE('GE', 'id 'GE_EventGad' gt="'GE_DataFile'" ref')
  1118.               call ToPIPE('GE', 'id 'GE_FontNameGad' dis=1 ref')
  1119.               call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=1 ref')
  1120.               call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=1 ref')
  1121.               call ToPIPE('GE', 'id 'GE_ResetGad' dis=1 ref')
  1122.               call ToPIPE('GE', 'id 'GE_TextColorGad' dis=1 ref')
  1123.               call ToPIPE('GE', 'id 'GE_LineGad' dis=1 ref')
  1124.               call ToPIPE('GE', 'id 'GE_BoxedGad' dis=1 ref')
  1125.               call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=1 ref')
  1126.               call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=1 ref')
  1127.             end
  1128.           end
  1129.           if GE_DataFile == '' then do
  1130.             GE_StartOrEnd = 1
  1131.             GE_EventType = Event$
  1132.             call ToPIPE('GE', 'id 'GE_EventTypeGad' s=0 ref')
  1133.             call ToPIPE('GE', 'id 'GE_EventGad' gt="" ref')
  1134.             call ToPIPE('GE', 'id 'GE_FontNameGad' dis=0 ref')
  1135.             call ToPIPE('GE', 'id 'GE_FontSizeGad' dis=0 ref')
  1136.             call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis=0 ref')
  1137.             call ToPIPE('GE', 'id 'GE_ResetGad' dis=0 ref')
  1138.             call ToPIPE('GE', 'id 'GE_TextColorGad' dis=0 ref')
  1139.             call ToPIPE('GE', 'id 'GE_LineGad' dis=0 ref')
  1140.             call ToPIPE('GE', 'id 'GE_BoxedGad' dis=0 ref')
  1141.             call ToPIPE('GE', 'id 'GE_BoxColorGad' dis=0 ref')
  1142.             call ToPIPE('GE', 'id 'GE_FrequencyGad' dis=0 ref')
  1143.           end
  1144.         end
  1145.       end
  1146.     /**/
  1147.  
  1148.     /***//*** GE_EventGad ***/
  1149.       when GE_GadID == GE_EventGad then GE_EventValue = GE_GadInfo1
  1150.     /**/
  1151.  
  1152.     /***//*** GE_FontNameGad ***/
  1153.       when GE_GadID == GE_FontNameGad then do
  1154.         call ToPIPE('GE', 'id 0 s=256')
  1155.         call CASimpleReq('FWCalendar 'Notice$, MustUse$)
  1156.         call ToPIPE('GE', 'id 0 s=512')
  1157.         call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1158.       end
  1159.     /**/
  1160.  
  1161.     /***//*** GE_FontSizeGad ***/
  1162.       when GE_GadID == GE_FontSizeGad then FontSize = GE_GadInfo1
  1163.     /**/
  1164.  
  1165.     /***//*** GE_ChooseFontGad ***/
  1166.       when GE_GadID == GE_ChooseFontGad then do
  1167.         if App == 'FW' then do
  1168.           GE_File = CAGetFile('GE', GetFileAllGad, SelectFont$, CurrentDir'FWFonts/SWOLFonts/')
  1169.           if GE_File ~= '' then do
  1170.             FontName = GE_File
  1171.             call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1172.           end
  1173.         end
  1174.         else if App == 'PGS' then do
  1175.           call ToPIPE('GE', 'id 0 s=256')
  1176.             FontName = ReadBrowserList('FontReq', 'FontGad', 'FontList', FontName)
  1177.             call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
  1178.           call ToPIPE('GE', 'id 0 s=512')
  1179.         end
  1180.       end
  1181.     /**/
  1182.  
  1183.     /***//*** GE_ResetGad ***/
  1184.       when GE_GadID == GE_ResetGad then do
  1185.         FontName = Font.Highlight
  1186.         FontSize = FSize.Highlight
  1187.         call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'"')
  1188.         call ToPIPE('GE', 'id 'GE_FontSizeGad' gt="'FontSize'"')
  1189.       end
  1190.     /**/
  1191.  
  1192.     /***//*** Date Gadgets ***/
  1193.       when GadArg.GE_GadID ~= '' then do
  1194.         if GE_EventType == File$ then GE_StartOrEnd = 0
  1195.         else GE_StartOrEnd = 1 - GE_StartOrEnd
  1196.         GE_ReturnDate = strip(left(GadArg.GE_GadID, 1)''right(GadArg.GE_GadID, 2), "B", "C")
  1197.         GE_Date = substr(GadArg.GE_GadID, 2)
  1198.         if GE_StartOrEnd == 0 then do
  1199.           call ToPIPE('GE', 'id 'GE_StartGad' gt="'GE_Date'" ref')
  1200.           GE_StartDate = GE_ReturnDate
  1201.         end
  1202.         else do
  1203.           call ToPIPE('GE', 'id 'GE_EndGad' gt="'GE_Date'" ref')
  1204.           GE_EndDate = GE_ReturnDate
  1205.         end
  1206.       end
  1207.     /**/
  1208.  
  1209.     /***//*** GE_TextColorGad ***/
  1210.       when GE_GadID == GE_TextColorGad then do
  1211.         call ToPIPE('GE', 'id 0 s=256')
  1212.         GE_TextColor = ReadBrowserList('NCColorReq', 'NCColorGad', 'ColorList')
  1213.         call ToPIPE('GE', 'id 'GE_TextColorGad' gt="'GE_TextColor'"')
  1214.         call ToPIPE('GE', 'id 0 s=512')
  1215.       end
  1216.     /**/
  1217.  
  1218.     /***//*** GE_LineGad ***/
  1219.       when GE_GadID == GE_LineGad then GE_EnteredLine = GE_GadInfo1
  1220.     /**/
  1221.  
  1222.     /***//*** GE_BoxedGad ***/
  1223.       when GE_GadID == GE_BoxedGad then GE_BoxValue = GE_Boxed.GE_GadInfo1
  1224.     /**/
  1225.  
  1226.     /***//*** GE_BoxColorGad ***/
  1227.       when GE_GadID == GE_BoxColorGad then do
  1228.         call ToPIPE('GE', 'id 0 s=256')
  1229.         GE_BoxColor = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
  1230.         call ToPIPE('GE', 'id 'GE_BoxColorGad' gt="'GE_BoxColor'"')
  1231.         call ToPIPE('GE', 'id 0 s=512')
  1232.       end
  1233.     /**/
  1234.  
  1235.     /***//*** GE_FrequencyGad ***/
  1236.       when GE_GadID == GE_FrequencyGad then GE_WeeklyValue = GE_Weekly.GE_GadInfo1
  1237.     /**/
  1238.  
  1239.     /***//*** GE_OKGad ***/
  1240.       when GE_GadID == GE_OKGad then do
  1241.         call writeln('GE', 'id 'GE_EventGad' read')
  1242.         GE_EventValue = readln('GE')
  1243.         call writeln('GE', 'id 'GE_FontSizeGad' read')
  1244.         FontSize = readln('GE')
  1245.         if (GE_StartDate == "") & (GE_EventType == Event$) then do
  1246.           call ToPIPE('GE', 'id 0 s=256')
  1247.           call CASimpleReq('FWCAddEvent 'Notice$, EnterStartDate$'...')
  1248.           call ToPIPE('GE', 'id 0 s=512')
  1249.         end
  1250.         else if (GE_EventValue == "") & (GE_BoxValue == "") then do
  1251.           call ToPIPE('GE', 'id 0 s=256')
  1252.           call CASimpleReq('FWCAddEvent 'Notice$, EnterEvent$'...')
  1253.           call ToPIPE('GE', 'id 0 s=512')
  1254.         end
  1255.         else do
  1256.           EventData = "   EventType = "GE_EventType||'0a'x||,
  1257.                       " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
  1258.                       " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
  1259.                       "   TextColor = "GE_TextColor||'0a'x||,
  1260.                       " EnteredLine = "GE_EnteredLine||'0a'x||,
  1261.                       "    BoxColor = "GE_BoxColor||'0a'x||,
  1262.                       "     Options = "GE_BoxValue""GE_WeeklyValue||'0a'x||,
  1263.                       " EnteredFont = "strip(FontName)||'0a'x||,
  1264.                       " EnteredSize = "strip(FontSize)||'0a'x||,
  1265.                       "EnteredEvent = "GE_EventValue
  1266.           call ToPIPE('GE', 'id 0 s=128')
  1267.           call ProcessEvent
  1268.           call ToPIPE('GE', 'id 0 s=64')
  1269.  
  1270.           GE_StartOrEnd = 1
  1271.           GE_StartDate  = ""
  1272.           GE_EndDate    = ""
  1273.           call ToPIPE('GE', 'id 'GE_StartGad' gt="" ref')
  1274.           call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
  1275.         end
  1276.       end
  1277.     /**/
  1278.  
  1279.       otherwise nop
  1280.     end
  1281.   end
  1282. /**/
  1283.   exit
  1284. /**/
  1285.  
  1286. /***//*** GetFontWidth (GFW) Subroutine ***/
  1287. GetFontWidth:
  1288.   parse arg GFW_FontType, GFW_Char
  1289.  
  1290.   GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  1291.   if App == 'FW' then do
  1292.     REDRAW
  1293.     GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
  1294.     DELETEOBJECT GFW_ID
  1295.   end
  1296.   else if App == 'PGS' then do
  1297.     GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
  1298.     GFW_Width = GFW_Text.Right - GFW_Text.Left
  1299.     DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  1300.   end
  1301. return GFW_Width
  1302. /**/
  1303.  
  1304. /***//*** GetHeight (GH) Subroutine ***/
  1305. GetHeight:
  1306.   parse arg GH_FontType
  1307.  
  1308.   if App == 'FW' then do
  1309.     TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
  1310.     DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
  1311.     GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
  1312.     DELETEOBJECT GH_id
  1313.   end
  1314.   else if App == 'PGS' then do
  1315.     DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
  1316.     SELECTTEXT AT 0 0 WINDOW winName
  1317.     BEGINCOMMANDCAPTURE
  1318.       SETLEADING RELATIVE 100
  1319.       SETTYPESIZE FSize.GH_FontType WINDOW winName
  1320.       SETFONT Font.GH_FontType WINDOW winName
  1321.     ENDCOMMANDCAPTURE
  1322.     INSERT 'A' WINDOW winName
  1323.     GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
  1324.     GH_Text.Height = GH_Text.Bottom - GH_Text.Top
  1325.     DELETEOBJECT OBJECTID GH_id WINDOW winName
  1326.   end
  1327.   return GH_Text.Height
  1328. /**/
  1329.  
  1330. /***//*** GetID (GI) Subroutine ***/
  1331. GetID:
  1332. parse arg GI_var
  1333.  
  1334. return id.GI_var
  1335. /**/
  1336.  
  1337. /***//*** GetWidth (GW) Subroutine ***/
  1338. GetWidth:
  1339.   parse arg GW_ID
  1340.  
  1341.   if App = 'FW' then do
  1342.     GETOBJECTCOORDS GW_ID
  1343.     Parse Var result . . . GW_width .
  1344.   end
  1345.   else if App == 'PGS' then do
  1346.     SELECTOBJECT OBJECTID GW_ID  WINDOW winName
  1347.     GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
  1348.     GW_width = GW_Temp.Right - GW_Temp.Left
  1349.   end
  1350.  
  1351.   return GW_width
  1352. /**/
  1353.  
  1354. /***//*** MemberID (MI) ***/
  1355. MemberID:
  1356.   parse arg MI_Member, MI_Array, MI_Count, MI_Start
  1357.  
  1358.   if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
  1359.   if MI_Start == '' then do
  1360.     if symbol(MI_Array'.Start') == 'VAR' then interpret 'MI_Start = 'MI_Array'.Start'
  1361.     else MI_Start = 0
  1362.   end
  1363.  
  1364.   do MI_i = MI_Start to MI_Start + MI_Count - 1
  1365.     if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  1366.   end
  1367.   return -1
  1368. /**/
  1369.  
  1370. /***//*** NameOnly (PROCEDURE) ***/
  1371. NameOnly: PROCEDURE
  1372.   parse arg FileWithPath
  1373.   return substr(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)) + 1)
  1374. /**/
  1375.  
  1376. /***//*** ParseVariables (PV) Subroutine ***/
  1377. ParseVariables:
  1378.   parse arg PV_Line
  1379.  
  1380.   PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  1381.   PV_VarString = ''
  1382.   PV_Var.      = '00'x
  1383.   PV_LongVar   = 4
  1384.   PV_LIT       = ''
  1385.   PV_Count     = 0
  1386.  
  1387.   do PV_i = 1 to words(PV_String)
  1388.     PV_Word = word(PV_String, PV_i)
  1389.     if pos(PV_Word'(', PV_Line) > 0 then iterate
  1390.     if datatype(PV_Word) == 'CHAR' then do
  1391.       if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
  1392.       if symbol(PV_Word) == 'VAR' then do
  1393.         PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
  1394.         if PV_Var.PV_Word == '00'x then do
  1395.           PV_Count = PV_Count + 1
  1396.           PV_Var.PV_Count = PV_Word
  1397.           PV_Var.PV_Word  = value(PV_Word)
  1398.         end
  1399.         if pos('.', PV_Word) > 0 then do
  1400.           PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
  1401.           do PV_j = 1 to words(PV_CompoundParts)
  1402.             PV_Subword = word(PV_CompoundParts, PV_j)
  1403.             if PV_Var.PV_SubWord == '00'x then do
  1404.               PV_Count = PV_Count + 1
  1405.               PV_Var.PV_Count = PV_SubWord
  1406.               if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
  1407.               else PV_Var.PV_SubWord  = value(PV_SubWord)
  1408.             end
  1409.           end
  1410.         end
  1411.       end
  1412.     end
  1413.   end
  1414.  
  1415.   do PV_i = 1 to PV_Count
  1416.     PV_Word = PV_Var.PV_i
  1417.     if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
  1418.     PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
  1419.     PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  1420.   end
  1421.  
  1422.   if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString
  1423.  
  1424.   return PV_VarString
  1425. /**/
  1426.  
  1427. /***//*** PathPart (PROCEDURE) ***/
  1428. PathPart: PROCEDURE
  1429.   parse arg FileWithPath
  1430.   return left(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)))
  1431. /**/
  1432.  
  1433. /***//*** PgmVer (PROCEDURE) ***/
  1434. PgmVer: PROCEDURE
  1435.   parse arg Program
  1436.  
  1437.   address command 'version 'Program '>PIPE:FWC file'
  1438.  
  1439.   return strip(word(ReadFile('PIPE:FWC'), 2))
  1440. /**/
  1441.  
  1442. /***//*** PrintText (PT) Subroutine ***/
  1443. PrintText:
  1444.   parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text
  1445.  
  1446.   if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  1447.   else PT_Font = Bold.PT_FontType
  1448.  
  1449.   if App == 'FW' then do
  1450.     if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
  1451.     PT_Top = PT_Top + TextAdj * Height.PT_FontType
  1452.     TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
  1453.     DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  1454.   end
  1455.   else if App == 'PGS' then do
  1456.     DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
  1457.     SELECTTEXT AT PT_Left PT_Top WINDOW winName
  1458.     BEGINCOMMANDCAPTURE
  1459.       SETLEADING RELATIVE 100
  1460.       SETTYPESIZE FSize.PT_FontType WINDOW winName
  1461.       SETTYPEWIDTH PT_Width WINDOW winName
  1462.       SETFONT PT_Font WINDOW winName
  1463.       SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
  1464.     ENDCOMMANDCAPTURE
  1465.     if pos('"', PT_Text) > 0 then do
  1466.       call WriteFile('PIPE:Text2Insert.txt', PT_Text)
  1467.       INSERTTEXT FILE 'PIPE:Text2Insert.txt' FILTER ASCII WINDOW winName
  1468.     end
  1469.     else INSERT '"'PT_Text'"' WINDOW winName
  1470.   end
  1471.   return PT_id
  1472. /**/
  1473.  
  1474. /***//*** ProcessEvent (PE) Subroutine ***/
  1475. ProcessEvent:
  1476.   Day1 = ''
  1477.   Day2 = ''
  1478.   EnteredLine = 1
  1479.   Options = ''
  1480.   EnteredEvent = ''
  1481.   Box = 0
  1482.   Weekly = 0
  1483.   WindowRefreshed = 0
  1484.   Keywords = '|FONT|SIZE|START|END|LINE|EVENT|OPTIONS|TEXTCOLOR|BOXCOLOR|ENTEREDFONT|ENTEREDSIZE|ENTEREDDAY1|ENTEREDDAY2|ENTEREDLINE|ENTEREDEVENT|'
  1485.  
  1486.   if EventData == 0 then call CleanUp
  1487.   call openv('EventData')
  1488.     do until eofv('EventData')
  1489.       PE_Ln = readvln('EventData')
  1490.       interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
  1491.     end
  1492.   call closev('EventData')
  1493.  
  1494.   Event. = ''
  1495.   if EventType == Event$ then do
  1496.     Event.0   = 1
  1497.     Event.1   = EventData
  1498.     EventFile = ''
  1499.   end
  1500.   else do
  1501.     EventFile = EnteredEvent
  1502.     if EnteredDay1 == '' then EnteredDay1 = 0
  1503.     RootDay = ConvertDay(EnteredDay1)
  1504.  
  1505.     call open('EventFile', EventFile)
  1506.       EventCount = 1
  1507.       do until eof('EventFile')
  1508.         Ln = ReadLn('EventFile')
  1509.         if eof('EventFile') == 0 then do
  1510.           if (pos('|'upper(word(Ln, 1))'|', Keywords) == 0) & (Ln ~= '') then do
  1511.             interpret Ln
  1512.             iterate
  1513.           end
  1514.           if Ln == '' then do
  1515.             if Event.1 ~= '' then EventCount = EventCount + 1
  1516.             iterate
  1517.           end
  1518.           Event.EventCount = Event.EventCount''Ln||'0a'x
  1519.         end
  1520.       end
  1521.       Event.0 = EventCount
  1522.     call close('EventFile')
  1523.   end
  1524.  
  1525.   if Event.0 > 1 then Req = OpenBusy(ProcessEvents$, Event.0)
  1526.   if App == 'PGS' then do
  1527.     REFRESH OFF ALL
  1528.   end
  1529.   do EC = 1 to Event.0
  1530.     if UpdateBusy(Req, 1) == -1 then call Cleanup
  1531.     Box    = 0
  1532.     Weekly = 0
  1533.     EnteredFont = Font.Highlight
  1534.     EnteredSize = FSize.Highlight
  1535.     EnteredDay1 = ''
  1536.     EnteredDay2 = ''
  1537.     EnteredLine = ''
  1538.     EnteredEvent = ''
  1539.     Options = ''
  1540.     BoxColor = ''
  1541.     TextColor = ''
  1542.  
  1543.     if Event.EC == '' then iterate
  1544.     call openv('Event.EC')
  1545.       do until eofv('Event.EC')
  1546.         PE_Ln = readvln('Event.EC')
  1547.         PE_Variable = upper(strip(word(PE_Ln, 1)))
  1548.         select
  1549.           when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
  1550.           when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
  1551.           when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
  1552.           when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
  1553.           when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
  1554.           when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
  1555.           when PE_Variable == 'OPTIONS' then nop
  1556.           when PE_Variable == 'TEXTCOLOR' then nop
  1557.           when PE_Variable == 'BOXCOLOR' then nop
  1558.           when PE_Variable == 'ENTEREDFONT' then nop
  1559.           when PE_Variable == 'ENTEREDSIZE' then nop
  1560.           when PE_Variable == 'ENTEREDDAY1' then nop
  1561.           when PE_Variable == 'ENTEREDDAY2' then nop
  1562.           when PE_Variable == 'ENTEREDLINE' then nop
  1563.           when PE_Variable == 'ENTEREDEVENT' then nop
  1564.           when PE_Variable == 'COMMENT' then nop
  1565.           otherwise PE_Variable = 'Error'
  1566.         end
  1567.         if PE_Variable ~= 'Error' then interpret PE_Variable'= strip(subword(PE_Ln, 3))'
  1568.       end
  1569.     call closev('Event.EC')
  1570.     if PE_Variable == 'Error' then do
  1571.       call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
  1572.       iterate EC
  1573.     end
  1574.     EnteredFont = strip(EnteredFont, 'B', '"'||"'")
  1575.     TextColor   = strip(TextColor, 'B', '"'||"'")
  1576.     BoxColor    = strip(BoxColor, 'B', '"'||"'")
  1577.     Options     = compress(upper(strip(Options, 'B', ' "'||"'")))
  1578.  
  1579.     if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)
  1580.  
  1581.     FontInfo = compress(EnteredFont''EnteredSize, '. /:')
  1582.     if FontKnown.FontInfo == '' then do
  1583.       HighestFont = HighestFont + 1
  1584.       FontKnown.FontInfo = HighestFont
  1585.       Font.HighestFont = EnteredFont
  1586.       FSize.HighestFont = EnteredSize
  1587.       Height.HighestFont = GetHeight(HighestFont) * Leading/100
  1588.     end
  1589.     CurrentFont = FontKnown.FontInfo
  1590.  
  1591.     If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
  1592.     If EnteredLine == '' then EnteredLine = 1
  1593.     if BoxColor    == '' then BoxColor = Background.AddEvent
  1594.     if TextColor   == '' then TextColor = Color.AddEvent
  1595.  
  1596.     if EventType = Event$ then do
  1597.       EnteredDay1 = ConvertDay(EnteredDay1)
  1598.       EnteredDay2 = ConvertDay(EnteredDay2)
  1599.     end
  1600.     else do
  1601.       EnteredDay1 = RootDay + EnteredDay1
  1602.       EnteredDay2 = RootDay + EnteredDay2
  1603.     end
  1604.     if EnteredDay1 > EnteredDay2 then do
  1605.       TempDate = EnteredDay1
  1606.       EnteredDay1 = EnteredDay2
  1607.       EnteredDay2 = TempDate
  1608.     end
  1609.  
  1610.     if pos('B', Options) ~= 0 then Box = 1
  1611.     if pos('W', Options) ~= 0 then Weekly = 1
  1612.     if pos('2', Options) ~= 0 then Weekly = 2
  1613.  
  1614.     /* Process Event */
  1615.     if App == 'PGS' then REFRESH OFF ALL
  1616.  
  1617.     do until Weekly == 0
  1618.       Event = EnteredEvent
  1619.       Line  = EnteredLine
  1620.       Day1  = EnteredDay1
  1621.       Day2  = EnteredDay2
  1622.       Text. = ''
  1623.  
  1624.       if Weekly > 0 then do
  1625.         if Day1 > MaxDate then Weekly = -1
  1626.         if Day2 > MaxDate then Day2 = MaxDate
  1627.       end
  1628.  
  1629.       if Weekly ~= -1 then do
  1630.         If Day1 ~= Day2 then Box = 1
  1631.         LineCount = 0
  1632.         do until Day1 > Day2
  1633.           Day1Row = trunc((Day1 + StartDate - 1) / 7)
  1634.           Day2Row = trunc((Day2 + StartDate - 1) / 7)
  1635.           Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
  1636.           Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
  1637.           if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
  1638.           if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0
  1639.  
  1640.           if Day1Row == Day2Row then do
  1641.             DaySpan = Day2Column - Day1Column + 1
  1642.             NextDay1 = Day1 + DaySpan
  1643.             if Day2Column + DaySpan > WeekdayCount then DaySpan = WeekdayCount - Day1Column + 1
  1644.           end
  1645.           else do
  1646.             DaySpan = WeekdayCount + 1 - Day1Column
  1647.             NextDay1 = Day1 + 7 - Day1Column
  1648.           end
  1649.  
  1650.           if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
  1651.           else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
  1652.           else CalDate = Day1
  1653.           if DoDateBox == 1 then HighlightOffset = CurveOffset + 1.25 * DateOffset + 2 * Width.WidthOfDate8
  1654.           else do
  1655.             Select
  1656.               when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
  1657.               when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
  1658.               otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
  1659.             end
  1660.           end
  1661.           HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
  1662.           If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
  1663.           else do
  1664.             if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
  1665.             else BoxTop = CalTop
  1666.           end
  1667.  
  1668.           LeftEdge = Margin.Left + Day1Column * BoxWidth + CurveOffset + HighlightOffset
  1669.           if event ~= '' then do
  1670.             Textline = 0
  1671.             Text.    = ''
  1672.             Text.Textline = event
  1673.  
  1674.             /* Accomodate user line breaks */
  1675.             do until LineBreak = 0
  1676.               LineBreak = pos('//', Text.Textline)
  1677.               if LineBreak > 0 then do
  1678.                 Nextline = Textline + 1
  1679.                 Text.Nextline = substr(Text.Textline, LineBreak + 2)
  1680.                 Text.Textline = left(Text.Textline, LineBreak - 1)
  1681.                 Textline = Nextline
  1682.               end
  1683.             end
  1684.             Textline = 0
  1685.  
  1686.             /* Fit line(s) into allowable space */
  1687.             do until Text.Nextline == ''
  1688.               Nextline = Textline + 1
  1689.               if Box == 1 | Textline == 0 then Indent.Textline = 0
  1690.               else Indent.Textline = 3 * DateOffset
  1691.               AllowedWidth = DaySpan * BoxWidth - 2 * CurveOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
  1692.               AllowedBoxWidth = AllowedWidth + 2 * CurveOffset
  1693.               if App == 'FW' & length(Text.Textline) > 37 then do
  1694.                 Wordbreak = lastpos(' ', Text.Textline, 37)
  1695.                 Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1696.                 Text.Textline = strip(left(Text.Textline, Wordbreak))
  1697.               end
  1698.               ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
  1699.               if App == 'FW' then redraw
  1700.               TextWidth.Textline = GetWidth(ID)
  1701.               if App == 'FW' then DELETEOBJECT ID
  1702.               else if App == 'PGS' then do
  1703.                 SELECTOBJECT OBJECTID ID WINDOW winName
  1704.                 DELETEOBJECT OBJECTID ID WINDOW winName
  1705.               end
  1706.  
  1707.               NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
  1708.               if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
  1709.                 /* Move last word to next line */
  1710.                 Wordbreak     = lastpos(' ', Text.Textline)
  1711.                 Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
  1712.                 Text.Textline = strip(left(Text.Textline, Wordbreak))
  1713.               end
  1714.               else if Text.Nextline ~= '' then Textline = Textline + 1
  1715.             end
  1716.             LineCount = Textline
  1717.           end
  1718.  
  1719.           MaxCompression = 1
  1720.           do i = 0 to LineCount
  1721.             MaxCompression = min(MaxCompression, NeededCompression.i)
  1722.           end
  1723.           TextWidth = MaxCompression * Width.CurrentFont
  1724.           if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)
  1725.  
  1726.           if Box then call DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
  1727.           if event ~= '' then do
  1728.             do i = 0 to LineCount
  1729.               Text.Top = BoxTop + (Line + i) * Height.Highlight
  1730.               if Box == 0 then Text.Left = LeftEdge + Indent.i
  1731.               else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i * MaxCompression) / 2
  1732.               call PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
  1733.             end
  1734.           end
  1735.  
  1736.           Day1 = NextDay1
  1737.           if Day1 > Day2 then leave
  1738.           else if (trunc((Day1 + StartDate - 1) / 7) > 4) & (Day2 > MonthLength.Month) then Day2 = Day1
  1739.         end
  1740.  
  1741.         if Weekly == 1 then do
  1742.           EnteredDay1 = EnteredDay1 + 7
  1743.           EnteredDay2 = EnteredDay2 + 7
  1744.         end
  1745.         else if Weekly == 2 then do
  1746.           EnteredDay1 = EnteredDay1 + 14
  1747.           EnteredDay2 = EnteredDay2 + 14
  1748.         end
  1749.       end
  1750.       else Weekly = 0
  1751.     end
  1752.     if App == 'FW' then redraw
  1753.     else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  1754.   end
  1755.  
  1756.   call CloseBusy(Req)
  1757.  
  1758.   if App == 'PGS' then do
  1759.     REFRESH ON ALL
  1760.     REFRESHWINDOW WINDOW winName
  1761.     WindowRefreshed = 1
  1762.   end
  1763.  
  1764. return
  1765. /**/
  1766.  
  1767. /***//*** QuoteIt (PROCEDURE) ***/
  1768. QuoteIt: PROCEDURE
  1769.   parse arg String
  1770.  
  1771.   String = strip(String)
  1772.   if (left(String, 1) == '"') & (right(String, 1) == '"') then return String
  1773.   else if (left(String, 1) == "'") & (right(String, 1) == "'") then return String
  1774.   else if pos("'", String) == 0 then return "'"String"'"
  1775.   else return '"'String'"'
  1776.  
  1777.   return
  1778. /**/
  1779.  
  1780. /***//*** ReadBrowserList (RBL) ***/
  1781. ReadBrowserList:
  1782.   parse arg RBL_FileHandle, RBL_GadIDList, RBL_ItemList, RBL_CurrentItem
  1783.  
  1784.   interpret 'RBL_AlreadyOpen = 'RBL_FileHandle
  1785.   if RBL_AlreadyOpen == 0 then do
  1786.     call ToPIPE(RBL_FileHandle, 'open')
  1787.     if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
  1788.     interpret RBL_FileHandle '= 1'
  1789.   end
  1790.   else do
  1791.     if RBL_CurrentItem ~= '' then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
  1792.     call ToPIPE(RBL_FileHandle, 'id 0 s=64')
  1793.   end
  1794.  
  1795.   do while ~eof(RBL_FileHandle)
  1796.     call ToPIPE(RBL_FileHandle, 'continue')
  1797.     RBL_Result = readln(RBL_FileHandle)
  1798.     parse var RBL_Result . . . . RBL_NodeID
  1799.     RBL_NodeID = strip(RBL_NodeID)
  1800.     interpret 'RBL_ListID = 'RBL_GadIDList'.RBL_NodeID'
  1801.     if pos('gadget', RBL_Result) > 0 then leave
  1802.   end
  1803.   call ToPIPE(RBL_FileHandle, 'id 0 s=128')
  1804.   interpret 'RBL_Entry = 'RBL_ItemList'.'RBL_ListID
  1805.   return RBL_Entry
  1806. /**/
  1807.  
  1808. /***//*** ReadFile (PROCEDURE) Subroutine ***/
  1809. ReadFile: PROCEDURE
  1810.   parse arg file
  1811.  
  1812.   if open('Temp', file) then do
  1813.     val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
  1814.     call close('Temp')
  1815.   end
  1816.   else val = ''
  1817.   return val
  1818. /**/
  1819.  
  1820. /***//*** ReadToEOL (PROCEDURE) Subroutine ***/
  1821. ReadToEOL: PROCEDURE
  1822.   parse arg Start, Var
  1823.  
  1824.   if Start == 0 then return ''
  1825.  
  1826.   EOL = pos('0a'x, Var, Start)
  1827.   if EOL == 0 then EOL = length(Var)
  1828.  
  1829.   return substr(Var, Start, EOL - Start)
  1830. /**/
  1831.  
  1832. /***//*** Syntax () Subroutine ***/
  1833. Syntax:
  1834.   signal off syntax
  1835.  
  1836.   ErrorLine  = SIGL
  1837.   SourceLine = strip(SourceLine(ErrorLine))
  1838.  
  1839.   call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  1840.   call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  1841.   call AddMsg('E', ParseVariables(SourceLine))
  1842.  
  1843.   call Cleanup
  1844.   exit
  1845. /**/
  1846.  
  1847. /***//*** ToPIPE (TP) ***/
  1848. ToPIPE:
  1849.   parse arg PipeName, TP_CMD
  1850.  
  1851.   call writeln(PipeName,' 'TP_CMD)
  1852.   TP_Response=readln(PipeName)
  1853.  
  1854.   parse var TP_Response TP_Response1 TP_Response2 .
  1855.  
  1856.   if TP_Response1 == 'ok' then return(TP_Response2)
  1857.   if TP_Response == '' then TP_Response = 'Blank line'
  1858.   call AddMsg('E', 'Line : 'SIGL)
  1859.   call AddMsg('E', PipeName' error: 'TP_Response)
  1860.   call AddMsg('E', 'Returned from: 'TP_CMD)
  1861.   call Cleanup
  1862. /**/
  1863.  
  1864. /***//*** TranslationStrings () ***/
  1865. TranslationStrings:
  1866. Sunday$    = 'Sunday'
  1867. Monday$    = 'Monday'
  1868. Tuesday$   = 'Tuesday'
  1869. Wednesday$ = 'Wednesday'
  1870. Thursday$  = 'Thursday'
  1871. Friday$    = 'Friday'
  1872. Saturday$  = 'Saturday'
  1873.  
  1874. January$   = 'January'
  1875. February$  = 'February'
  1876. March$     = 'March'
  1877. April$     = 'April'
  1878. May$       = 'May'
  1879. June$      = 'June'
  1880. July$      = 'July'
  1881. August$    = 'August'
  1882. September$ = 'September'
  1883. October$   = 'October'
  1884. November$  = 'November'
  1885. December$  = 'December'
  1886.  
  1887. AddEvent$       = 'Add Event'
  1888. AddIC$          = '+IC'
  1889. All$            = 'All'
  1890. BiOrWeekly$     = '(Bi)Weekly'
  1891. Biweekly$       = 'Biweekly'
  1892. Bottom$         = 'Bottom'
  1893. BoxColor$       = 'Box'
  1894. BoxDates$       = 'Box Dates'
  1895. Boxed$          = '_Boxed'
  1896. Calendar$       = 'Calendar'
  1897. Calendars$      = 'Calendars'
  1898. Cancel$         = '_Cancel'
  1899. CantFind$       = "can't be found"
  1900. Center$         = 'Center'
  1901. Clear$          = 'Clear'
  1902. Color$          = 'Color'
  1903. Colors$         = 'Colors'
  1904. Comment$        = 'Comment'
  1905. Critical$       = 'Critical error'
  1906. DailyColors$    = 'Use daily colors'
  1907. DeleteEvent$    = 'Delete Event'
  1908. Done$           = 'Done'
  1909. Easter$         = 'Easter'
  1910. End$            = 'End'
  1911. EnterEvent$     = 'You must enter an event...'
  1912. EnterEventInfo$ = 'Enter event information'
  1913. EnterNewIC$     = 'Enter new ImageClass'
  1914. EnterStartdate$ = 'You must enter a start date...'
  1915. Even$           = 'Even'
  1916. Event$          = 'Event'
  1917. Extended$       = 'Extended'
  1918. File$           = 'File'
  1919. First$          = 'First'
  1920. Fixed$          = 'Fixed'
  1921. Floating$       = 'Floating'
  1922. Font$           = 'Font'
  1923. Fonts$          = 'Fonts'
  1924. ForDetails$     = 'for details'
  1925. ForwardContent$ = 'Forward contents of output to'
  1926. ForwardLog$     = 'Forward log file to'
  1927. Fourth$         = 'Fourth'
  1928. Frequency$      = 'Frequency'
  1929. GeneratingM$    = 'Generating %s %s calendar'
  1930. GeneratingY$    = 'Generating %s calendar'
  1931. Go$             = 'Go'
  1932. Header$         = '%s %s'
  1933. HighlightEd$    = 'Highlight Editor'
  1934. Highlights$     = 'Highlights'
  1935. History$        = 'History'
  1936. Holiday$        = 'Holiday'
  1937. Images$         = 'Images'
  1938. Julian$         = 'Julian'
  1939. JulJulLeft$     = 'Jul/Jul Left'
  1940. JulLeft$        = 'Jul Left'
  1941. Last$           = 'Last'
  1942. Left$           = 'Left'
  1943. Line$           = '_Line'
  1944. Load$           = '_Load'
  1945. MatchColors$    = 'Date Color = Highlight Color'
  1946. MiniCals$       = 'MiniCals'
  1947. MiscVar$        = 'Miscellaneous Variables'
  1948. MultiMonth$     = 'Multi-Month'
  1949. MustUse$        = 'You must use the gadget to'||'0a'x||'the right for this value.'
  1950. NextDay$        = 'Next day'
  1951. Noncritical$    = 'Noncritical warning'
  1952. None$           = 'None'
  1953. NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
  1954. Note$           = 'Notes'
  1955. NoteBox$        = 'Note box'
  1956. Notice$         = 'notice'
  1957. Odd$            = 'Odd'
  1958. OK$             = '_OK'
  1959. OK2$            = 'OK'
  1960. Once$           = 'Once'
  1961. Options$        = 'Options'
  1962. OptLayout$      = 'Options & Layout'
  1963. OrientMarg$     = 'Orientation & Margins'
  1964. Phases$         = 'Phases'
  1965. PleaseWait$     = 'please wait'
  1966. PrepReq$        = 'Preparing requester'
  1967. PreviousDay$    = 'Prev day'
  1968. ProcessEvents$  = 'Processing events'
  1969. Random$         = 'Random'
  1970. Reset$          = '_Reset'
  1971. Right$          = 'Right'
  1972. RiseSet$        = 'Rise/Set'
  1973. SaveAs$         = '_Save as'
  1974. Second$         = 'Second'
  1975. See$            = 'see'
  1976. SeeOutput$      = 'see the output above for details'
  1977. SeeShell$       = 'see the shell output for details'
  1978. SelectApp$      = 'Select application'
  1979. SelectFile$     = 'Select data file'
  1980. SelectFont$     = 'Select font'
  1981. SelectImage$    = 'Select image'
  1982. SelectPrefs$    = 'Select name for prefs file'
  1983. SingleMonth$    = 'Single Month'
  1984. Start$          = 'Start'
  1985. SubHeader$      = ''
  1986. Sunrise$        = 'Sunrise'
  1987. Sunset$         = 'Sunset'
  1988. Tall$           = 'Tall'
  1989. TextColor$      = 'Text'
  1990. Third$          = 'Third'
  1991. Top$            = 'Top'
  1992. TopLong$        = 'Extra week at top'
  1993. Type$           = 'Type'
  1994. Unable$         = 'if you are unable to resolve the problem.'
  1995. VarGUITitle$    = 'Set desired variables'
  1996. Variables$      = 'Variables'
  1997. Weekend$        = 'Weekend'
  1998. Weekly$         = 'Weekly'
  1999. WeekNumber$     = 'Week Number'
  2000. WeekType$       = 'Week Type'
  2001. WholeYear$      = 'Whole Year'
  2002. Wide$           = 'Wide'
  2003.  
  2004. Help$                       = 'Help message'
  2005. Help$.ClickTabHelp          = 'Different tabs display*ndifferent variables'
  2006. Help$.MiniCalsGadHelp       = 'Include mini-calendars showing*nthe previous & next months'
  2007. Help$.HighlightsGadHelp     = 'Include highlights on*nthe generated calendar'
  2008. Help$.ImagesGadHelp         = 'Include images on*nthe generated calendar'
  2009. Help$.BoxDatesGadHelp       = 'Surround day numbers*nwith boxes'
  2010. Help$.ExtendedGadHelp       = 'Include days from the previous*nand next months on the*ngenerated calendar'
  2011. Help$.TopLongGadHelp        = 'Include days from the sixth week*nat the top of the calendar'
  2012. Help$.NoteBoxGadHelp        = 'Include an area to write notes*nwhere no dates are printed'
  2013. Help$.TopMargGadHelp        = "Set calendar's top margin*nRemember to <RETURN>"
  2014. Help$.LeftMargGadHelp       = "Set calendar's left margin*nRemember to <RETURN>"
  2015. Help$.OrientationGadHelp    = "Set calendar's orientation"
  2016. Help$.RightMargGadHelp      = "Set calendar's right margin*nRemember to <RETURN>"
  2017. Help$.BottomMargGadHelp     = "Set calendar's bottom margin*nRemember to <RETURN>"
  2018. Help$.FontVarGadHelp        = 'Select the font variable to set'
  2019. Help$.FontValGadHelp        = 'Displays the choosen font value'
  2020. Help$.ChooseFontGadHelp     = 'Select the desired font'
  2021. Help$.ColorVarGadHelp       = 'Select the color variable to set'
  2022. Help$.CycleColorVarGadHelp  = 'Cycle through the color variables*nShift to reverse cycle'
  2023. Help$.ColorValGadHelp       = 'Select the desired color'
  2024. Help$.MatchColorsGadHelp    = 'Use the highlight text color*nfor the date/date box'
  2025. Help$.DailyColorsGadHelp    = 'Use the Color.(Weekday) colors*nfor the date/date box'
  2026. Help$.HighlightEditGadHelp  = 'Bring up the*nHighlight Editor'
  2027. Help$.MiscVarGadHelp        = 'Select the desired*nmiscellaneous variable'
  2028. Help$.CycleMiscVarGadHelp   = 'Cycle through the miscellaneous variables*nShift to reverse cycle'
  2029. Help$.MiscValGadHelp        = 'Enter the desired variable value'
  2030. Help$.ChooseValGadHelp      = 'Used only for selecting files/paths'
  2031. Help$.AddImageClassGadHelp  = 'Add an ImageClass variable'
  2032. Help$.Extra3Help            = "Select extra to be printed*nin calendar's top-center"
  2033. Help$.Extra4Help            = "Select extra to be printed*nin calendar's top-right"
  2034. Help$.Extra0Help            = "Select extra to be printed*nin calendar's bottom-left"
  2035. Help$.Extra1Help            = "Select extra to be printed*nin calendar's bottom-center"
  2036. Help$.Extra2Help            = "Select extra to be printed*nin calendar's bottom-right"
  2037. Help$.CalendarTypeGadHelp   = 'Select calendar type'
  2038. Help$.EndMonthGadHelp       = 'Select desired end month'
  2039. Help$.StartMonthGadHelp     = 'Select desired start month'
  2040. Help$.MonthGadHelp          = 'Select desired month'
  2041. Help$.YearGadHelp           = 'Select or enter desired year'
  2042. Help$.GoGadHelp             = 'Begin generation of calendar'
  2043. Help$.ResetGadHelp          = 'Reset all variables to defaults'
  2044. Help$.LoadGadHelp           = 'Load a new preference file'
  2045. Help$.SaveAsGadHelp         = 'Save current settings to*na new preference file'
  2046. Help$.CancelGadHelp         = 'Cancel FWCalendar'
  2047. Help$.EH_EventGadHelp       = 'Enter the Highlight as it*nwill show up on calendar'
  2048. Help$.EH_ChooseEventGadHelp = 'Select Image file to be printed on calendar'
  2049. Help$.EH_ListEventGadHelp   = 'List all Highlights*nfor current month'
  2050. Help$.EH_CycleEventGadHelp  = 'Cycle through all Highlights*nfor current month'
  2051. Help$.EH_CommentGadHelp     = 'Enter optional comment'
  2052. Help$.EH_MonthGadHelp       = 'Select month to work with'
  2053. Help$.ExtraDHelp            = 'Select the date on*nwhich the Highlight falls'
  2054. Help$.LD                    = 'Indicates the Highlight always falls*non the last day of the month'
  2055. Help$.EH_ColorGadHelp       = 'Select color to be*nused for the Highlight'
  2056. Help$.EH_HLTypeGadHelp      = 'Select the Highlight type'
  2057. Help$.EH_WeekNumberGadHelp  = 'Select which week a floating*nHighlight occurs in'
  2058. Help$.EH_WeekTypeGadHelp    = 'Select frequency of weekly Highlights'
  2059. Help$.EH_WeekendGadHelp     = 'Determine whether or not the*nHighlight can fall on a weekend'
  2060. Help$.EH_HolidayGadHelp     = 'Treat the Highlight as a holiday'
  2061. Help$.EH_EasterGadHelp      = 'The number of days before or*nafter Easter for the Highlight'
  2062. Help$.EH_AddEventGadHelp    = 'Add a new Highlight'
  2063. Help$.EH_DeleteEventGadHelp = 'Delete the currently*ndisplayed Highlight'
  2064. Help$.EH_DoneGadHelp        = 'Save all changes to Highlights'
  2065. Help$.GE_EventTypeGadHelp   = 'Select to enter Event or*nuse an Event file'
  2066. Help$.GE_EventGadHelp       = 'Enter Event or display Event file'
  2067. Help$.GE_FontNameGadHelp    = 'Display font to be used'
  2068. Help$.GE_FontSizeGadHelp    = 'Enter font size to use'
  2069. Help$.GE_ChooseFontGadHelp  = 'Select font to be used'
  2070. Help$.GE_ResetGadHelp       = 'Reset font and font size'
  2071. Help$.GadIDHelp             = 'Enter Event start and end dates'
  2072. Help$.GE_StartGadHelp       = 'Display Event start date'
  2073. Help$.GE_EndGadHelp         = 'Display Event end date'
  2074. Help$.GE_TextColorGadHelp   = 'Select color to be*nused for Event text'
  2075. Help$.GE_LineGadHelp        = 'Select row on which*nEvent will be printed'
  2076. Help$.GE_BoxedGadHelp       = 'Surround Event with a box'
  2077. Help$.GE_BoxColorGadHelp    = 'Select color for box*nsurrounding Event'
  2078. Help$.GE_FrequencyGadHelp   = 'Select frequency of Event'
  2079. Help$.GE_OKGadHelp          = 'Use entered data to add*nEvent to calendar'
  2080. Help$.GE_CancelGadHelp      = 'Cancel FWCAddEvent'
  2081.  
  2082. return 0
  2083. /**/
  2084.  
  2085. /***//*** VIO Routines () Subroutine ***/
  2086. /***//** OpenV() **/
  2087. OpenV:
  2088.   parse arg VIO_Variable
  2089.  
  2090.   if Open.VIO_Variable ~= 1 then do
  2091.     Open.VIO_Variable = 1
  2092.     Pointer.VIO_Variable = 1
  2093.     EOF.VIO_Variable = 0
  2094.     return 1
  2095.   end
  2096.   else return 0
  2097. /**/
  2098.  
  2099. /***//** CloseV() **/
  2100. CloseV:
  2101.   parse arg VIO_Variable
  2102.  
  2103.   If Open.VIO_Variable == 0 then return 0
  2104.   Open.VIO_Variable = 0
  2105.   return 1
  2106. /**/
  2107.  
  2108. /***//** SeekV() **/
  2109. SeekV:
  2110.   parse arg VIO_Variable, VIO_Offset, VIO_Anchor
  2111.  
  2112.   if Open.VIO_Variable == 1 then do
  2113.     VIO_Anchor = upper(left(VIO_Anchor, 1))
  2114.  
  2115.     VIO_Value = Value(VIO_Variable)
  2116.     select
  2117.       when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
  2118.       when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
  2119.       otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
  2120.     end
  2121.  
  2122.     if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
  2123.     return Pointer.VIO_Variable
  2124.   end
  2125.   else return 0
  2126. /**/
  2127.  
  2128. /***//** ReadVCh() **/
  2129. ReadVCh:
  2130.   parse arg VIO_Variable, VIO_Length
  2131.  
  2132.   if VIO_Length == '' then VIO_Length = 1
  2133.  
  2134.   if Open.VIO_Variable == 1 then do
  2135.     if EOF.VIO_Variable == 0 then do
  2136.       VIO_Value = Value(VIO_Variable)
  2137.       VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
  2138.       Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
  2139.       if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
  2140.       else EOF.VIO_Variable = 0
  2141.     end
  2142.     else VIO_Ret = ''
  2143.   end
  2144.   else VIO_Ret = ''
  2145.  
  2146.   return VIO_Ret
  2147. /**/
  2148.  
  2149. /***//** ReadVLn(RV) **/
  2150. ReadVLn:
  2151.   parse arg VIO_Variable, VIO_Count, VIO_SepChar
  2152.  
  2153.   if VIO_Count == '' then VIO_Count = 1
  2154.   if VIO_SepChar == '' then VIO_SepChar = '0a'x
  2155.  
  2156.   if Open.VIO_Variable == 1 then do
  2157.     VIO_Value = Value(VIO_Variable)
  2158.     VIO_Ret   = ''
  2159.     do VIO_i = 1 to VIO_Count
  2160.       VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
  2161.       if VIO_LF > 0 then do
  2162.         VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
  2163.         Pointer.VIO_Variable = VIO_LF + 1
  2164.         if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
  2165.         else EOF.VIO_Variable = 0
  2166.       end
  2167.       else do
  2168.         if Pointer.VIO_Variable < length(VIO_Value) then do
  2169.           VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
  2170.           Pointer.VIO_Variable = length(VIO_Value) + 1
  2171.           EOF.VIO_Variable = 1
  2172.         end
  2173.       end
  2174.       if EOF.VIO_Variable == 1 then leave
  2175.       if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
  2176.     end
  2177.   end
  2178.   else VIO_Ret = ''
  2179.  
  2180.   return VIO_Ret
  2181. /**/
  2182.  
  2183. /***//** WriteVCh() **/
  2184. WriteVCh:
  2185.   parse arg VIO_Variable, VIO_String, VIO_Option
  2186.  
  2187.   VIO_Value  = Value(VIO_Variable)
  2188.   VIO_Option = upper(left(VIO_Option, 1))
  2189.   VIO_Length = length(VIO_Value)
  2190.   if VIO_Option == 'C' then do
  2191.     VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
  2192.     Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  2193.   end
  2194.   else if VIO_Option == 'B' then do
  2195.     VIO_Value = VIO_String''VIO_Value
  2196.     Pointer.VIO_Variable = length(VIO_String) + 1
  2197.   end
  2198.   else do
  2199.     VIO_Value = VIO_Value''VIO_String
  2200.     Pointer.VIO_Variable = length(VIO_Value)
  2201.   end
  2202.   interpret VIO_Variable'= VIO_Value'
  2203.   if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  2204.   else VIO_Ret = 0
  2205.  
  2206.   return VIO_Ret
  2207. /**/
  2208.  
  2209. /***//** WriteVLn() **/
  2210. WriteVLn:
  2211.   parse arg VIO_Variable, VIO_String, VIO_Option
  2212.  
  2213.   return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
  2214. /**/
  2215.  
  2216. /***//** EOFV() **/
  2217. EOFV:
  2218.   parse arg VIO_Variable
  2219.  
  2220.   if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  2221.   else return 1
  2222. /**/
  2223. /**/
  2224.  
  2225. /***//*** WriteFile (PROCEDURE) Subroutine ***/
  2226. WriteFile: PROCEDURE
  2227.   parse arg file, var, which
  2228.  
  2229.   if open('Temp', file, 'W') then do
  2230.     success = writech('Temp', var)
  2231.     call close('Temp')
  2232.   end
  2233.   if (upper(which) == 'B') & (upper(left(file, 4)) == 'ENV:') then call WriteFile('ENVARC:'substr(file, 5), var)
  2234.  
  2235.   return success
  2236. /**/
  2237.  
  2238. /***//*** SetVariables Subroutine ***/
  2239. SetVariables:
  2240. /***//**** Initialize Variables ****/
  2241.   Date            = 0
  2242.   esc             = "1B"x
  2243.   QuoteMark       = d2c(34)
  2244.   EventFile       = ''
  2245.   FontKnown.      = ''
  2246.   FSize.          = 10
  2247.   HighestFont     = 5
  2248.   Highlight       = 5
  2249.   PatVar          = '#?.data'
  2250.   PrefsFile       = ''
  2251.   Req             = 0
  2252.   Storage         = 'RAM:FWC/'
  2253.   Width.          = 100
  2254.   ColorW          = 80
  2255.   ColorH          = 10
  2256.  
  2257.   if App == 'FW' then DefaultFont = "SoftSans"
  2258.   else if App == 'PGS' then DefaultFont = 'PageStream-Normal'
  2259.  
  2260.   D.0 = 'Sunday'
  2261.   D.1 = 'Monday'
  2262.   D.2 = 'Tuesday'
  2263.   D.3 = 'Wednesday'
  2264.   D.4 = 'Thursday'
  2265.   D.5 = 'Friday'
  2266.   D.6 = 'Saturday'
  2267.  
  2268.   MonthLength.1    = 31
  2269.   MonthLength.2    = 28
  2270.   MonthLength.3    = 31
  2271.   MonthLength.4    = 30
  2272.   MonthLength.5    = 31
  2273.   MonthLength.6    = 30
  2274.   MonthLength.7    = 31
  2275.   MonthLength.8    = 31
  2276.   MonthLength.9    = 30
  2277.   MonthLength.10   = 31
  2278.   MonthLength.11   = 30
  2279.   MonthLength.12   = 31
  2280.  
  2281.   Month.1  = January$
  2282.   Month.2  = February$
  2283.   Month.3  = March$
  2284.   Month.4  = April$
  2285.   Month.5  = May$
  2286.   Month.6  = June$
  2287.   Month.7  = July$
  2288.   Month.8  = August$
  2289.   Month.9  = September$
  2290.   Month.10 = October$
  2291.   Month.11 = November$
  2292.   Month.12 = December$
  2293. /**/
  2294.  
  2295. /***//**** Read default variables ****/
  2296.   call open('Temp', FullCallPath)
  2297.     call seek('Temp', -5000, 'E')
  2298.     Chunk = readch('Temp', 65535)
  2299.     EndPos = pos('VarList:'||'0a'x, Chunk)
  2300.     if EndPos == 0 then do
  2301.       call AddMsg('E', 'Unable to locate default variables.')
  2302.       call CleanUp
  2303.     end
  2304.     RD_VariableFile = substr(Chunk, EndPos + 9)
  2305.   call close('Temp')
  2306.   interpret left(RD_VariableFile, pos('return', RD_VariableFile) - 1)
  2307. /**/
  2308.  
  2309. /***//**** Determine prefs file from calendar ****/
  2310.   if App == 'FW' then do
  2311.     FIRSTOBJECT; TempDateID = result
  2312.     do forever
  2313.       if TempDateID == 0 then do
  2314.         call AddMsg('E', 'Unable to find FWC date string.')
  2315.         call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  2316.         call Cleanup
  2317.       end
  2318.       GETOBJECTTYPE TempDateID; ObjectType = result
  2319.       if ObjectType == 7 then do
  2320.         GETTEXTBLOCKTEXT TempDateID; TempDate = result
  2321.         if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
  2322.       end
  2323.       NEXTOBJECT TempDateID; TempDateID = result
  2324.     end
  2325.     do while right(TempDate, 1) == '|'
  2326.       StartObj = pos('|', TempDate)
  2327.       NextObj = strip(substr(TempDate, StartObj), 'B', '|')
  2328.       if NextObj == TempDateID then NextObj = NextObj - 1
  2329.       GETTEXTBLOCKTEXT NextObj; NextPart = result
  2330.       TempDate = left(TempDate, StartObj - 1)''NextPart
  2331.     end
  2332.   end
  2333.   else if App = 'PGS' then do
  2334.     CURRENTWINDOW; winName = '"'RESULT'"'
  2335.     SELECTTEXT at 0 0 WINDOW winName
  2336.     SELECTTEXT ALL WINDOW winName
  2337.     EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
  2338.     TempDate = ReadFile("PIPE:FWC")
  2339.     SENDTOBACK WINDOW winName
  2340.     if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
  2341.       call AddMsg('E', 'Unable to find FWC date string.')
  2342.       call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
  2343.       call Cleanup
  2344.     end
  2345.     else do
  2346.       do while right(TempDate, 1) == '|'
  2347.         StartPointer = pos('|', TempDate)
  2348.         SELECTTEXT at 0 0 WINDOW winName
  2349.         SELECTTEXT ALL WINDOW winName
  2350.         EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
  2351.         TempDate = left(TempDate, StartPointer - 1)''readfile("PIPE:FWC")
  2352.         SENDTOBACK WINDOW winName
  2353.       end
  2354.     end
  2355.   end
  2356.   PrefsFile = substr(TempDate, 12)
  2357.   TempDate = substr(TempDate, 4, 8)
  2358. /**/
  2359.  
  2360. /***//**** Get application colors ****/
  2361.   if App == 'FW' then do
  2362.     FWPrefs = ReadFile(CurrentDir'FWFiles/FW.Prefs')
  2363.     ColorTable = pos('SWCL', FWPrefs) + 12
  2364.     EndTable = pos('STUP', FWPrefs)
  2365.     ColorCount = 0
  2366.     Do CTPos = ColorTable to EndTable by 20
  2367.       ColorRegister.ColorCount = c2x(substr(FWPrefs, CTPos - 3, 3))
  2368.       ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
  2369.       if ColorRegister.ColorCount = '000000' then Black$ = ColorList.ColorCount
  2370.       if ColorRegister.ColorCount = 'FFFFFF' then White$ = ColorList.ColorCount
  2371.       ColorCount = ColorCount + 1
  2372.     end
  2373.     ColorList.ColorCount = '<'Clear$'>'
  2374.     ColorCount = ColorCount + 1
  2375.     ColorList.COUNT = ColorCount
  2376.     if symbol('Black$') == 'LIT' then do
  2377.       call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
  2378.       Black$ = ColorList.0
  2379.     end
  2380.     if symbol('White$') == 'LIT' then do
  2381.       call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
  2382.       White$ = ColorList.1
  2383.     end
  2384.   end
  2385.   else if App == 'PGS' then do
  2386.     GETFONTLIST FontList
  2387.     FontList.COUNT = result
  2388.  
  2389.     PGSColors = ReadFile(CurrentDir''word(PgmVersion, 1)'.colors')
  2390.     ColorCount = 0
  2391.     StartTag = pos('TG'||'00'x, PGSColors)
  2392.     do while StartTag ~= 0
  2393.       Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
  2394.       AccentMarker = pos(d2c(129), Color)
  2395.       do while AccentMarker > 0
  2396.         Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
  2397.         AccentMarker = pos(d2c(129), Color)
  2398.       end
  2399.       ColorList.ColorCount = Color
  2400.       ColorCount = ColorCount + 1
  2401.       StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
  2402.     end
  2403.     ColorList.ColorCount = '<'Clear$'>'
  2404.     ColorCount = ColorCount + 1
  2405.     ColorList.COUNT = ColorCount
  2406.     White$ = ColorList.0
  2407.     Black$ = ColorList.1
  2408.   end
  2409.   TextColorList.Count = ColorList.COUNT - 1
  2410.  
  2411.   do i = 0 to TextColorList.Count - 1
  2412.     TextColorList.i = ColorList.i
  2413.   end
  2414.  
  2415.   Color.          = Black$
  2416.   Line.           = Black$
  2417.   Background.     = White$
  2418. /**/
  2419.  
  2420.   GSI_Data = ReadFile(PrefsFile)
  2421.   if GSI_Data ~= '' then do
  2422.     GSI_UpperData = upper(GSI_Data)
  2423.     interpret ReadToEOL(pos('STORAGE', GSI_UpperData), GSI_UpperData)
  2424.     interpret ReadToEOL(pos('FORCEBGUI', GSI_UpperData), GSI_UpperData)
  2425.     interpret ReadToEOL(pos('HOSTSCREEN', GSI_UpperData), GSI_UpperData)
  2426.  
  2427.     if ForceBGUI == 1 then call AddBGUI
  2428.     if HostScreen ~= '' then AppScreen = HostScreen
  2429.   end
  2430.   address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
  2431.  
  2432.   if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
  2433.     UserFile = ReadFile(PrefsFile)
  2434.     if UserFile ~= '' then do
  2435.       call openv('UserFile')
  2436.         do until eofv('UserFile')
  2437.           CD_VarLine = strip(ReadvLn('UserFile'))
  2438.           if left(CD_VarLine, 15) == '/* End Pass One' then leave
  2439.           if upper(left(CD_VarLine, 11)) == 'IMAGECLASS.' then iterate
  2440.           interpret CD_VarLine
  2441.         end
  2442.       call closev('UserFile')
  2443.     end
  2444.   end
  2445.   drop Orientation
  2446.  
  2447.   Type.0    = Event$
  2448.   Type.1    = File$
  2449.   FSize.4pt = 4
  2450.  
  2451.   CalendarBorder = CalendarBorder / 100
  2452.   CalendarShadow = CalendarShadow / 100
  2453.   CornerRadius   = CornerRadius / 100
  2454.   DateOffset     = DateOffset / 100
  2455.   StretchDateH   = StretchDateH / 100
  2456.   StretchDateW   = StretchDateW / 100
  2457.   TextAdj        = TextAdj / 100
  2458.   TTextArea      = TTextArea / 100
  2459.   WTextArea      = WTextArea / 100
  2460.  
  2461.   do i = 0 to 6
  2462.     val = i - StartWeek
  2463.     if val < 0 then val = 7 + val
  2464.     interpret 'Day.'D.i '=' val
  2465.     interpret 'Day.val = 'D.i'$'
  2466.   end
  2467.  
  2468.   if EndWeek < 0 then EndWeek = StartWeek - 1
  2469.   if EndWeek < 0 then EndWeek = 6
  2470.   if EndWeek < StartWeek then WeekdayCount = EndWeek + 7 - StartWeek
  2471.   else WeekdayCount = EndWeek - StartWeek
  2472.  
  2473.   if App == 'FW' then do
  2474.     TextBase = TextAdj
  2475.     do i = 0 to 5 by 5
  2476.       if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
  2477.       if ~exists(Font.i) then do
  2478.         call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
  2479.         Font.i = DefaultFont
  2480.       end
  2481.     end
  2482.     GETPAGESETUP ORIENT; FWC_Orientation = result
  2483.     if FWC_Orientation == 'Wide' then TextArea = WTextArea
  2484.     else TextArea = TTextArea
  2485.  
  2486.     GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
  2487.     DISPLAYPREFS Measure Inches
  2488.     GETSECTIONSETUP Top Bottom Inside Outside
  2489.     parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right
  2490.  
  2491.     GETPAGESETUP Width Height
  2492.     parse var result FullWidth FullHeight
  2493.  
  2494.     TextBlockPrefs TEXTFLOW None
  2495.   end
  2496.   else if App = 'PGS' then do
  2497.     TextBase = 1
  2498.     GETFONTLIST FontNames
  2499.     FontNames.COUNT = result
  2500.     do i = 0 to 5 by 5
  2501.       do j = 0 to FontNames.COUNT - 1
  2502.         if upper(Font.i) == upper(FontNames.j) then leave
  2503.       end
  2504.       if j == FontNames.COUNT then do
  2505.         call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
  2506.         Font.i = DefaultFont
  2507.       end
  2508.     end
  2509.     GETMASTERPAGES MPage; PageName = MPage.0
  2510.     GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
  2511.     UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
  2512.     SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
  2513.     GETMARGINGUIDES temp
  2514.     Margin.Left   = temp.inside
  2515.     Margin.Right  = temp.outside
  2516.     Margin.Top    = temp.top
  2517.     Margin.Bottom = temp.bottom
  2518.  
  2519.     GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
  2520.     if layout.orientation == 'LANDSCAPE' then do
  2521.       TextArea   = WTextArea
  2522.       FullWidth  = layout.height
  2523.       FullHeight = layout.width
  2524.     end
  2525.     else do
  2526.       TextArea   = TTextArea
  2527.       FullWidth  = layout.width
  2528.       FullHeight = layout.height
  2529.     end
  2530.   end
  2531.   PrintWidth       = FullWidth - Margin.Left - Margin.Right
  2532.   PrintHeight      = FullHeight - Margin.Top - Margin.Bottom
  2533.  
  2534.   if App == 'FW' then do
  2535.     GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  2536.   end
  2537.   else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  2538.   if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
  2539.       PrintHeight = PrintHeight - Height.4pt
  2540.  
  2541.   CalendarBorder   = CalendarBorder * PrintWidth
  2542.   CalendarShadow   = CalendarShadow * PrintWidth
  2543.   PrintWidth       = PrintWidth - 2 * CalendarBorder - CalendarShadow
  2544.   PrintHeight      = PrintHeight - 2 * CalendarBorder - CalendarShadow
  2545.   Margin.Left      = Margin.Left + CalendarBorder
  2546.  
  2547.   BoxWidth         = PrintWidth/(WeekdayCount + 1)
  2548.   CalRight         = Margin.Left + BoxWidth * (WeekdayCount + 1)
  2549.   TextArea         = TextArea * PrintHeight
  2550.   CalTop           = TextArea + Margin.Top + CalendarBorder
  2551.   BoxHeight        = (PrintHeight - TextArea)/5
  2552.   CRadius          = CornerRadius * min(BoxHeight, BoxWidth)
  2553.   CurveOffset      = DateOffset * BoxWidth + CRadius * .25
  2554.   DateOffset       = DateOffset * BoxWidth
  2555.   FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  2556.   Width.Date       = Width.Date * StretchDateW / StretchDateH
  2557.   FSize.Highlight  = BoxHeight/AddEventRows * 72
  2558.   if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  2559.   if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  2560.   Height.Highlight = GetHeight(Highlight) * Leading/100
  2561.   Height.Date      = GetHeight(Date) * Leading/100
  2562.  
  2563.   FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  2564.   FontKnown.FontInfo = Highlight
  2565.  
  2566.   RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  2567.   Width.WidthOfDate1 = GetFontWidth(Date, '1')
  2568.   Width.WidthOfDate8 = GetFontWidth(Date, '8')
  2569.   VariablesSet = 1
  2570. return
  2571. /**/
  2572.  
  2573. /***//*** VarList () Subroutine ***/
  2574. VarList:
  2575.   AddEventRows             = 9
  2576.   AdjustDST                = 1
  2577.   AltColor.Date            = Black$
  2578.   AltColor.Extended        = Black$
  2579.   AltColor.Highlight       = Black$
  2580.   AltColor.HighlightH      = Black$
  2581.   AltColor.History         = Black$
  2582.   AltColor.Julian          = Black$
  2583.   AltColor.Random          = Black$
  2584.   AltColor.Sunrise         = Black$
  2585.   AltColor.Sunset          = Black$
  2586.   AltColor.WeekNumber      = Black$
  2587.   Background.AddEvent      = White$
  2588.   Background.CalShadow     = Black$
  2589.   Background.Highlight     = '<'Clear$'>'
  2590.   Background.HighlightH    = '<'Clear$'>'
  2591.   Background.MiniCal       = White$
  2592.   Background.MiniCalShadow = Black$
  2593.   Background.NoteBox       = '<'Clear$'>'
  2594.   Background.Standard      = '<'Clear$'>'
  2595.   Background.Weekend       = '<'Clear$'>'
  2596.   BelzierFactor            = .55
  2597.   Bold.MiniCal             = DefaultBold
  2598.   Bold.FYMiniCal           = DefaultBold
  2599.   CalendarBorder           = 0
  2600.   CalendarShadow           = 0
  2601.   CenterHistory            = 1
  2602.   CenterMiniDates          = 1
  2603.   CenterRandom             = 1
  2604.   Color.Sunday             = Black$
  2605.   Color.Monday             = Black$
  2606.   Color.Tuesday            = Black$
  2607.   Color.Wednesday          = Black$
  2608.   Color.Thursday           = Black$
  2609.   Color.Friday             = Black$
  2610.   Color.Saturday           = Black$
  2611.   Color.AddEvent           = Black$
  2612.   Color.Date               = Black$
  2613.   Color.Extended           = Black$
  2614.   Color.Header             = Black$
  2615.   Color.Highlight          = Black$
  2616.   Color.HighlightH         = Black$
  2617.   Color.History            = Black$
  2618.   Color.Julian             = Black$
  2619.   Color.MiniCal            = Black$
  2620.   Color.Moon               = Black$
  2621.   Color.NoteBox            = Black$
  2622.   Color.Random             = Black$
  2623.   Color.SubHeader          = Black$
  2624.   Color.Sunrise            = Black$
  2625.   Color.Sunset             = Black$
  2626.   Color.Weekday            = Black$
  2627.   Color.WeekNumber         = Black$
  2628.   CornerRadius             = 0
  2629.   DateOffset               = 2
  2630.   DoDailyColors            = 0
  2631.   DoDateBox                = 0
  2632.   DoExtended               = 1
  2633.   DoHide                   = 0
  2634.   DoHighlights             = 0
  2635.   DoHistory                = ''
  2636.   DoImages                 = 0
  2637.   DoJulian                 = ''
  2638.   DoJulianLeft             = ''
  2639.   DoMatchColors            = 0
  2640.   DoMiniCals               = 1
  2641.   DoNoteBox                = 0
  2642.   DoPhases                 = ''
  2643.   DoRandom                 = ''
  2644.   DoSunRise                = ''
  2645.   DoSunSet                 = ''
  2646.   DoTopExtraWk             = 0
  2647.   DoWeekNumber             = ''
  2648.   FinalView                = 75
  2649.   Font.Date                = DefaultFont
  2650.   Font.Extras              = DefaultFont
  2651.   Font.Header              = DefaultFont
  2652.   Font.Highlight           = DefaultFont
  2653.   Font.MiniCal             = DefaultFont
  2654.   Font.FYMiniCal           = DefaultFont
  2655.   Font.Weekday             = DefaultFont
  2656.   Font.SubHeader           = DefaultFont
  2657.   ForceBGUI                = 0
  2658.   GenMVars                 = 'Month.Month EnteredYear'
  2659.   GenYVars                 = 'EnteredYear'
  2660.   GfxApp                   = 'Visage'
  2661.   GfxAppPath               = ''
  2662.   HeaderLoc                = 9
  2663.   HeaderSize               = 50
  2664.   Header$                  = '%s %s'
  2665.   HeaderVars               = 'Month.Month Year'
  2666.   HelpTime                 = 4
  2667.   HighlightRows            = 9
  2668.   HostScreen               = ''
  2669.   LaunchM                  = ''
  2670.   LaunchY                  = ''
  2671.   Leading                  = 100
  2672.   Line.AddEvent            = Black$
  2673.   Line.CalBorder           = Black$
  2674.   Line.Extended            = Black$
  2675.   Line.Grid                = Black$
  2676.   Line.MiniCal             = Black$
  2677.   Line.NoteBox             = Black$
  2678.   MagnifyExtras            = 100
  2679.   Margin.Bottom            = 0
  2680.   Margin.Left              = 0
  2681.   Margin.Right             = 0
  2682.   Margin.Top               = 0
  2683.   MinHistoryWidth          = 70
  2684.   MinRandomWidth           = 70
  2685.   MinWidth                 = 80
  2686.   MaxImgHeight             = 75
  2687.   MaxImgWidth              = 75
  2688.   MiniCalHeight            = 60
  2689.   MiniCalSpacing           = 0.5
  2690.   MiniCalWidth             = 200
  2691.   MoonRadius               = 10
  2692.   Orientation              = 'Wide'
  2693.   PrefsName                = 'Default'
  2694.   ShadowType               = 'P'
  2695.   ShiftLMini               = 0
  2696.   ShiftRMini               = 0
  2697.   StartWeek                = 0
  2698.   StretchDateH             = 100
  2699.   StretchDateW             = 100
  2700.   SubHeaderLoc             = 0
  2701.   SubHeaderSize            = 0
  2702.   SubHeader$               = ''
  2703.   SubHeaderVars            = ''
  2704.   SunCalcPath              = ''
  2705.   Text.Julian              = ''
  2706.   Text.Sunrise             = ''
  2707.   Text.Sunset              = ''
  2708.   Text.WeekNumber          = ''
  2709.   TextAdj                  = 77
  2710.   TTextArea                = 15
  2711.   WeekdaySize              = 50
  2712.   WTextArea                = 20
  2713. return
  2714. /**/
  2715.  
  2716.